unit uObjects ;

interface

uses
  SysUtils,
  Classes,
  Graphics,
  Windows,
  ExtCtrls,
  ComCtrls,
  Controls,
  Forms,
  Menus,
  Contnrs,
  VirtualScrollBox,
  VirtualTrees,
  uBasic,
  GDIPOBJ,
  GDIPAPI ;

type
  { forward }
  TMedaProject = class ;
  TMedaModule = class ;
  TMedaVisible = class ;
  TMedaContainer = class ;
  TMedaVisibleContainer = class ;
  TMedaPart = class ;
  TMedaNet = class ;
  TMedaPort = class ;
  TMedaPin = class ;
  TMedaWire = class ;
  TMedaLabel = class ;
  TMedaPower = class ;
  TMedaPad = class ;
  TMedaTrack = class ;
  TMedaVia = class ;

  TMedaObject = class( TMedaViewable )
  private
    fModule : TMedaModule ;             { Owner }
    fParent : TMedaContainer ;          { Parent }
    fDesignator : string ;
    fPath : TGPGraphicsPath ;

    fPlaceRef : TGUID ;
    fLayerType : TMedaLayerType ;

    fTransforms : array[ 0..3 ] of TMedaTransform ;

    fFlags : TMedaFlagsSet ;

    procedure SetFlags( const Value : TMedaFlagsSet ) ; virtual ;
    function GetFlagsAsString : string ; virtual ;
    procedure SetFlagsAsString( const Value : string ) ; virtual ;

    function GetCount : integer ; virtual ;
    procedure SetModule( const Value : TMedaModule ) ; virtual ;

    function GetDesignator : string ; virtual ;
    procedure SetDesignator( const Value : string ) ; virtual ;
    procedure SetParent( const Value : TMedaContainer ) ; virtual ;

    function GetTransform( index : integer ) : TMedaTransform ; virtual ;
    procedure SetTransform( index : integer ; const Value : TMedaTransform ) ; virtual ;

    procedure SetPath( const Value : TGPGraphicsPath ) ;
    function GetBounds : TGPRectF ; virtual ;

    function GetLink : TMedaObject ; virtual ;
    function GetLayer : TMedaLayerType ; virtual ;
    function GetPage : TMedaPageNumber ; virtual ;
    procedure SetLayerType( const Value : TMedaLayerType ) ; virtual ;
    function GetLayerType : TMedaLayerType ; virtual ;
    function GetPlaceRef : TGUID ; virtual ;
    procedure SetPlaceRef( const Value : TGUID ) ; virtual ;
    procedure SetPlaceRefAsString( const Value : string ) ; virtual ;
    procedure SetPosition( const Value : TGPPointF ) ;
    function GetPlaceRefAsString : string ;
  protected
    fView : TMedaViewable ;
    procedure SetView( const Value : TMedaViewable ) ; virtual ;
    procedure Update ; override ;
    procedure BuildPath ; virtual ;
    function GetOutline : TGPRectF ; virtual ;
    procedure SetOutline( const Value : TGPRectF ) ; virtual ;
  public
    procedure SetSelection( aFlag : TMedaState ) ; override ;
    function GetChild( index : integer ) : TMedaViewable ; override ;
    function GetText( aColumn : integer ) : string ; override ;
    function GetIcon : TIconType ; override ;
    function GetColor : TGPColor ; override ;
    function CanEdit( aColumn : integer ) : boolean ; override ;
    procedure Sort ; virtual ;
  public
    constructor Create ;
    destructor Destroy ; override ;

    procedure Vaporize ; virtual ;
    function Clone : TMedaObject ; virtual ;
    procedure Assign( aObject : TMedaObject ) ; virtual ;

    property Count : integer read GetCount ;

    function Accept( Visitor : TObject ) : TObject ; override ;
    function AcceptView( Visitor : TObject ) : TObject ; virtual ;
    function IsPlaced : boolean ; override ;
    property Parent : TMedaContainer read fParent write SetParent ;
    property View : TMedaViewable read FView write SetView ;

    property Designator : string read GetDesignator write SetDesignator ;
    property Module : TMedaModule read fModule write SetModule ;
    procedure Invalidate ; override ;

    property Link : TMedaObject read GetLink ;
    procedure LinkPort ; virtual ;

    procedure Build( aName : string ) ; overload ; virtual ;

    procedure PlaceMe ; virtual ;
    procedure Unplace ; virtual ;
    function Placed : boolean ; virtual ;
    function PlacedAt( aPlace : TMedaViewable ) : boolean ; virtual ;

    property PlaceRef : TGUID read GetPlaceRef write SetPlaceRef ;
    property PlaceRefAsString : string read GetPlaceRefAsString write SetPlaceRefAsString ;

    property Page : TMedaPageNumber read GetPage ;
    property Layer : TMedaLayerType read GetLayer ;
    property LayerType : TMedaLayerType read GetLayerType write SetLayerType ;

    procedure Rotate( aAngle : integer ) ; virtual ;
    procedure Mirrorize ; virtual ;

    function Show : TPoint ; override ;

    property Transforms[ index : integer ] : TMedaTransform read GetTransform write SetTransform ;
    property Position : TGPPointF read fTransforms[ 0 ].Position write SetPosition ;
    property Rotation : integer read fTransforms[ 0 ].Rotation ;
    property Mirror : boolean read fTransforms[ 0 ].Mirror ;
    property Flags : TMedaFlagsSet read fFlags write SetFlags ;
    property FlagsAsString : string read GetFlagsAsString write SetFlagsAsString ;

    function FindNodeByGUID( aID : TGUID ) : TMedaObject ; virtual ;

    property Outline : TGPRectF read GetOutline write SetOutline ;
    procedure BuildOutline( const aOutline : array of double ) ;

    function GetConnector( aPos : TGPPointF ) : TGPPointF ; virtual ;
    property Bounds : TGPRectF read GetBounds ;

    property Path : TGPGraphicsPath read fPath write SetPath ;
    procedure AddPolygon( aPoints : array of TGPPointF ) ; virtual ;
    procedure AddLine( x1, y1, x2, y2 : single ) ; virtual ;
    procedure AddRectangle( x1, y1, x2, y2 : single ) ; virtual ;
    procedure AddRoundRect( x1, y1, x2, y2, r : single ) ; virtual ;
    procedure AddSemiRoundRect( x1, y1, x2, y2, r : single ) ; virtual ;
    procedure AddSemiRoundRect2( x1, y1, x2, y2, r : single ) ; virtual ;
    procedure AddEllipse( x1, y1, x2, y2 : single ) ; virtual ;
    procedure AddArc( x1, y1, x2, y2 : single ; a1, a2 : single ) ;
  public
    function IsSchemPhysical : boolean ; virtual ;
    function IsPCBPhysical : boolean ; virtual ;
  end ;

  TMedaVisible = class( TMedaObject )
  private
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMedaContainer = class( TMedaObject )
  private
    fObjects : TObjectlist ;
    function GetObjects( index : integer ) : TMedaObject ; virtual ;
    procedure SetObjects( index : integer ; const Value : TMedaObject ) ; virtual ;
    procedure SetTransform( index : integer ; const Value : TMedaTransform ) ; override ;
    procedure SetModule( const Value : TMedaModule ) ; override ;
    procedure SetParent( const Value : TMedaContainer ) ; override ;
    function GetCount : integer ; override ;
    function GetObjectCount : integer ;
    procedure SetPlaceRef( const Value : TGUID ) ; override ;
  public
    procedure Mark ; override ;
  public
    function GetIcon : TIconType ; override ;
    function GetChildCount : integer ; override ;
    function GetChild( index : integer ) : TMedaViewable ; override ;
    function GetText( aColumn : integer ) : string ; override ;
    function GetColor : TGPColor ; override ;
    procedure Sort ; override ;
  public
    constructor Create ;
    destructor Destroy ; override ;

    function Clone : TMedaObject ; override ;
    function Accept( Visitor : TObject ) : TObject ; override ;
    procedure Clear ; virtual ;
    procedure Vaporize ; override ;
    procedure Invalidate ; override ;

    property Objects[ index : integer ] : TMedaObject read GetObjects write SetObjects ; default ;
    property ObjectCount : integer read GetObjectCount ;
    procedure Add( var aObject : TMedaObject ) ; virtual ;
    function Extract( aObject : TMedaObject ) : TMedaObject ; virtual ;
    procedure Remove( aObject : TMedaObject ) ; virtual ;
    procedure Delete( index : integer ) ; virtual ;
    procedure RemoveAll ; virtual ;

    procedure Rotate( aAngle : integer ) ; override ;
    procedure Mirrorize ; override ;
    procedure Unplace ; override ;
    procedure PlaceMe ; override ;

    function FindNodeByGUID( hHandle : TGUID ) : TMedaObject ; override ;
  end ;

  TMedaTriStateContainer = class( TMedaContainer )
  private
    fSortIndex : integer ;
  public
    function CheckType : TCheckType ; override ;
  end ;

  TMedaVisibleContainer = class( TMedaContainer )
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMedaSubContainer = class( TMedaTriStateContainer )
  public
    procedure Add( var aObject : TMedaObject ) ; override ;
    procedure Remove( aObject : TMedaObject ) ; override ;
    procedure Delete( index : integer ) ; override ;
    function Extract( aObject : TMedaObject ) : TMedaObject ; override ;
    procedure RemoveAll ; override ;
  end ;

  TMedaStack = class ;

  // TMedaRatsNest is the set of all ports connected by one net
  // It can paint itself on a page or the PCB.
  // All connections represented by some physical thing
  // like a line or track should not be painted

  TMedaRatsNest = class( TMedaTriStateContainer )
  private
    fPlace : TMedaViewable ;
    procedure SetParent( const Value : TMedaContainer ) ; override ;
  public
    procedure Sort ; override ;
  public
    constructor Create ;
    function Accept( Visitor : TObject ) : TObject ; override ;
    procedure Vaporize ; override ;

    procedure Add( var aObject : TMedaObject ) ; override ;
    procedure Remove( aObject : TMedaObject ) ; override ;
    procedure Delete( index : integer ) ; override ;
    function Extract( aObject : TMedaObject ) : TMedaObject ; override ;

    procedure PaintAtSchematic( aGraphics : TMedaGraphics ; aPlace : TMedaViewable ) ;
    procedure PaintAtPCB( aGraphics : TMedaGraphics ) ;
  end ;

  // TMedaNet is an aggregate of connections between ports of modules,
  // and the physical representations: lines, labels, powers, tracks, coppers and via's

  TMedaNet = class( TMedaTriStateContainer )
  private
    fPorts : TMedaRatsNest ;
    fWires : TMedaSubContainer ;
    fLabels : TMedaSubContainer ;
    fPowers : TMedaSubContainer ;
    fVias : TMedaSubContainer ;
    fTracks : TMedaSubContainer ;

    fPortType : TMedaPortType ;

    procedure SetPortType( const Value : TMedaPortType ) ;

    procedure SetPower( const Value : boolean ) ;
    function GetPower : boolean ;
    function GetLines( index : integer ) : TMedaWire ;
    function GetLabels( index : integer ) : TMedaLabel ;
    function GetPowers( index : integer ) : TMedaPower ;
    function GetTracks( index : integer ) : TMedaTrack ;
    function GetVias( index : integer ) : TMedaVia ;
    function GetPorts( index : integer ) : TMedaPort ;
  protected
  public
    function GetIcon : TIconType ; override ;
    function GetColor : TGPColor ; override ;
    function GetText( aColumn : integer ) : string ; override ;
  public
    constructor Create ;
    function Accept( Visitor : TObject ) : TObject ; override ;

    property Power : boolean read GetPower write SetPower ;
    property PortType : TMedaPortType read fPortType write SetPortType ;
    function IsPort : boolean ; virtual ;

    procedure Add( var aObject : TMedaObject ) ; override ;

    property Ports[ index : integer ] : TMedaPort read GetPorts ;
    procedure ConnectPort( aPort : TMedaPort ) ; overload ;
    function ExtractPort( aObject : TMedaPort ) : TMedaPort ; virtual ;
    function PortCount : integer ; virtual ;

    property Wires[ index : integer ] : TMedaWire read GetLines ;
    function AddWire : TMedaWire ; virtual ;
    function ExtractWire( aObject : TMedaWire ) : TMedaWire ; virtual ;
    procedure DeleteWires ; virtual ;
    function WireCount : integer ; virtual ;

    property Labels[ index : integer ] : TMedaLabel read GetLabels ;
    function AddLabel : TMedaLabel ; virtual ;
    function ExtractLabel( aObject : TMedaLabel ) : TMedaLabel ; virtual ;
    function LabelCount : integer ; virtual ;

    property Powers[ index : integer ] : TMedaPower read GetPowers ;
    function AddPower : TMedaPower ; virtual ;
    function ExtractPower( aObject : TMedaPower ) : TMedaPower ; virtual ;
    function PowerCount : integer ; virtual ;

    property Tracks[ index : integer ] : TMedaTrack read GetTracks ;
    function AddTrack : TMedaTrack ; virtual ;
    function ExtractTrack( aObject : TMedaTrack ) : TMedaTrack ; virtual ;
    procedure DeleteTracks ; virtual ;
    function TrackCount : integer ; virtual ;

    property Vias[ index : integer ] : TMedaVia read GetVias ;
    function AddVia : TMedaVia ; virtual ;
    function ExtractVia( aObject : TMedaVia ) : TMedaVia ; virtual ;
    function ViaCount : integer ; virtual ;

    procedure Remove( aObject : TMedaObject ) ; override ;

    procedure Join( aNet : TMedaNet ) ;
    //        procedure GatherLines( aPlace : TMedaViewable ) ;

    procedure SchematicPointMoved( const aFrom, aTo : TGPPointF ) ;
    function GetSchematicPoints : TMedaWirePoints ; virtual ;

    property RatsNest : TMedaRatsNest read fPorts ;
  end ;

  TMedaBank = class ;
  TMedaShape = class ;

  // TMedaPart is a aggregate of ports, banks and shapes
  // together they form a physical thing, a device

  TMedaPart = class( TMedaTriStateContainer )
  private
    { Private declarations }
    fPorts : TMedaSubContainer ;
    fBanks : TMedaSubContainer ;
    fShapes : TMedaSubContainer ;

    function GetBank( aMap : string ) : TMedaBank ; virtual ;
    function GetBanks( index : integer ) : TMedaBank ;
    function GetPorts( index : integer ) : TMedaPort ;
    function GetShapes( index : integer ) : TMedaShape ;
    procedure SetBanks( index : integer ; const Value : TMedaBank ) ;
    procedure SetPorts( index : integer ; const Value : TMedaPort ) ;
    procedure SetShapes( index : integer ; const Value : TMedaShape ) ;
    function GetNets( index : integer ) : TMedaNet ;
    procedure SetNets( index : integer ; const Value : TMedaNet ) ;
  protected
  public
    function GetText( aColumn : integer ) : string ; override ;
    function GetIcon : TIconType ; override ;
    function GetColor : TGPColor ; override ;
  public
    constructor Create ;
    function Accept( Visitor : TObject ) : TObject ; override ;
    function Clone : TMedaObject ; override ;
    procedure Assign( aObject : TMedaObject ) ; override ;

    procedure Add( var aObject : TMedaObject ) ; override ;

    property Ports[ index : integer ] : TMedaPort read GetPorts write SetPorts ;
    function PortCount : integer ; virtual ;
    function AddPort : TMedaPort ; virtual ;
    function PortByDesignator( aDesignator : string ) : TMedaNet ; overload ; virtual ;
    function PortByName( aName : string ) : TMedaNet ; virtual ;
    function PortByGUID( hPort : TGUID ) : TMedaPort ; virtual ;

    property Nets[ index : integer ] : TMedaNet read GetNets write SetNets ;
    function NetCount : integer ; virtual ;
    function AddNet : TMedaNet ; virtual ;

    property Banks[ index : integer ] : TMedaBank read GetBanks write SetBanks ;
    function BankCount : integer ; virtual ;
    function AddBank : TMedaBank ; virtual ;
    function FirstBank : TMedaBank ; virtual ;
    procedure LoadBank( aFilename : string ) ;
    function BankByName( const aGate : string ) : TMedaBank ;

    property Shapes[ index : integer ] : TMedaShape read GetShapes write SetShapes ;
    function ShapeCount : integer ; virtual ;
    function AddShape : TMedaShape ; virtual ;
    function FirstShape : TMedaShape ; virtual ;
    procedure LoadShape( aFilename : string ) ;

    procedure UpdatePorts ; overload ;
    procedure UpdatePorts( const aBank : TMedaBank ) ; overload ;
    procedure UpdatePorts( const aShape : TMedaShape ) ; overload ;

    procedure PlaceMe ; override ;

    procedure Remove( aObject : TMedaObject ) ; override ;
  end ;

  // TMedaPort is an external interface of a module (or part) and is a net in a module

  TMedaPort = class( TMedaNet )
  private
    fNet : TMedaNet ;                   { connected to other ports by this net }
    fPin : TMedaPin ;                   { delegate pin in Schematic }
    fStack : TMedaStack ;

    function GetNet : TMedaNet ;
    procedure SetNet( const Value : TMedaNet ) ;
    function GetPin : TMedaPin ;
    procedure SetPin( const Value : TMedaPin ) ;
    function GetStack : TMedaStack ;
    procedure SetStack( const Value : TMedaStack ) ;

    procedure SetParent( const Value : TMedaContainer ) ; override ;
  public
    function GetText( aColumn : integer ) : string ; override ;
    function GetChildCount : integer ; override ;
    function GetChild( index : integer ) : TMedaViewable ; override ;
    function GetIcon : TIconType ; override ;
    function GetColor : TGPColor ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
    function Clone : TMedaObject ; override ;
    procedure Assign( aObject : TMedaObject ) ; override ;
    procedure Vaporize ; override ;
    procedure Invalidate ; override ;

    property Net : TMedaNet read GetNet write SetNet ;
    property Pin : TMedaPin read GetPin write SetPin ;
    property Stack : TMedaStack read GetStack write SetStack ;
  end ;

  // TMedaBank is a keeper of a set of pins, together forming
  // a schematic symbol of a device or part of device
  // A device can have several banks, each keeping some pins. Multi gate devices
  // have similar banks. Power pins can be in a separate bank. There is no
  // explicit difference between homogenious or heterogeneous multi-bank parts

  TMedaBank = class( TMedaVisibleContainer )
  private
    { Private declarations }
    function GetPins( index : integer ) : TMedaPin ;
    procedure SetPins( index : integer ; const Value : TMedaPin ) ;
    function GetLink : TMedaObject ; override ;

  protected
    procedure SetOutline( const Value : TGPRectF ) ; override ;
  public
    function GetChildCount : integer ; override ;
    function GetText( aColumn : integer ) : string ; override ;
    function GetIcon : TIconType ; override ;
    function CheckType : TCheckType ; override ;
    function GetColor : TGPColor ; override ;
  public
    { Public declarations }
    constructor Create ;
    function Accept( Visitor : TObject ) : TObject ; override ;
    procedure Assign( aObject : TMedaObject ) ; override ;
    function Clone : TMedaObject ; override ;

    procedure BuildOutline ; virtual ;

    property Pins[ index : integer ] : TMedaPin read GetPins write SetPins ;
    function AddPin : TMedaPin ; virtual ;
    function PinByDesignator( aDesignator : string ) : TMedaPin ;
  end ;

  // TMedaSymbol is a schematic symbol of a module.

  TMedaSymbol = class( TMedaBank )
  private
  protected
    procedure SetOutline( const Value : TGPRectF ) ; override ;
  public
  end ;

  // TMedaPin is a schematic representation of a port.

  TMedaPin = class( TMedaVisible )
  private
    fPinType : TMedaPortType ;
    fPort : TMedaPort ;
    fSize : integer ;
    fOffset : TGPPointF ;               { offset in x, y to the origin of the container box }
    fDirection : TMedaDir ;             { orientation of pin on the box }
    fPortRef : TGUID ;

    procedure SetOffset( const Value : TGPPointF ) ;
    procedure SetDirection( const Value : TMedaDir ) ;
    procedure SetPinType( const Value : TMedaPortType ) ;
    function GetSize : integer ;
    procedure SetSize( const Value : integer ) ;
    function GetLink : TMedaObject ; override ;
    procedure SetPort( const Value : TMedaPort ) ;
    function GetDesignator : string ; override ;
    procedure SetPortRef( const Value : TGUID ) ;
    procedure SetPortRefAsString( const Value : string ) ;
  protected
    procedure BuildPath ; override ;
    function GetOutline : TGPRectF ; override ;
  public
    function GetName : string ; override ;
    function GetText( aColumn : integer ) : string ; override ;
    function GetIcon : TIconType ; override ;
    function CheckType : TCheckType ; override ;
    function GetColor : TGPColor ; override ;
  public
    constructor Create ;
    destructor Destroy ; override ;
    function Clone : TMedaObject ; override ;
    function Accept( Visitor : TObject ) : TObject ; override ;
    procedure Assign( aObject : TMedaObject ) ; override ;
    procedure Vaporize ; override ;

    property Port : TMedaPort read fPort write SetPort ;
    property PortRef : TGUID read FPortRef write SetPortRef ;
    property PortRefAsString : string write SetPortRefAsString ;

    property Offset : TGPPointF read fOffset write SetOffset ;
    property Size : integer read GetSize write SetSize ;

    function GetConnector( aPos : TGPPointF ) : TGPPointF ; override ;

    property Direction : TMedaDir read fDirection write SetDirection ;
    property PinType : TMedaPortType read fPinType write SetPinType ;

    procedure Build( aRotation : TMedaDir ; aType : TMedaPortType ) ; reintroduce ; overload ;
  end ;

  // TMedaWire is used to represent a net on a schematic

  TMedaWire = class( TMedaVisible )
  private
    function GetNet : TMedaNet ;
    function GetLink : TMedaObject ; override ;
  protected
    function GetOutline : TGPRectF ; override ;
  public
    function GetIcon : TIconType ; override ;
    function CheckType : TCheckType ; override ;
    function GetColor : TGPColor ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;

    property Net : TMedaNet read GetNet ;
    procedure AddStroke( aPoint1, aPoint2 : TGPPointF ) ;
    procedure AddDot( aPoint : TGPPointF ) ;
    function GetConnector( aPos : TGPPointF ) : TGPPointF ; override ;
    function GetPoints( var aPoint1, aPoint2 : TGPPointF ) : boolean ; virtual ;
    procedure SetPoints( const aPoint1, aPoint2 : TGPPointF ) ; virtual ;
    procedure MovePoint( aFrom, aTo : TGPPointF ) ; virtual ;
  end ;

  // TMedaTrack is used to represent a net on a PCB

  TMedaTrack = class( TMedaWire )
  private
    fWidth : single ;
    procedure SetWidth( const Value : single ) ;
    function GetLink : TMedaObject ; override ;
  protected
    function GetOutline : TGPRectF ; override ;
  public
    function GetIcon : TIconType ; override ;
    function GetColor : TGPColor ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
    property Width : single read fWidth write SetWidth ;
    procedure PlaceMe ; override ;
  public
    function IsPCBPhysical : boolean ; override ;
  end ;

  // TMedaShape is a keeper of a set of pins together forming
  // a PCB footprint of a device or part of a device
  // A part can also have several alternative footprints.

  TMedaShape = class( TMedaVisibleContainer )
  private
    function GetStacks( index : integer ) : TMedaStack ;
    procedure SetStacks( index : integer ; const Value : TMedaStack ) ;
    function GetLink : TMedaObject ; override ;
  protected
    procedure SetOutline( const Value : TGPRectF ) ; override ;
  public
    function GetChildCount : integer ; override ;
    function GetIcon : TIconType ; override ;
    function GetText( aColumn : integer ) : string ; override ;
    function CheckType : TCheckType ; override ;
    function GetColor : TGPColor ; override ;
  public
    constructor Create ;
    function Accept( Visitor : TObject ) : TObject ; override ;

    property Stacks[ index : integer ] : TMedaStack read GetStacks write SetStacks ;
    function AddStack : TMedaStack ; virtual ;
    function StackCount : integer ; virtual ;
    procedure CloneStack( aStack : TMedaStack ) ;
    function StackByDesignator( aDesignator : string ) : TMedaStack ;
    procedure LoadStack( aFilename : string ) ;

    procedure PlaceMe ; override ;
  end ;

  // TMedaStack represents a port on a PCB. It holds pads for one or
  // various layers. Through hole stacks have a hole.

  TMedaStack = class( TMedaContainer )
  private
    fPort : TMedaPort ;
    fOffset : TGPPointF ;               { offset in x, y to the origin of the container box }
    fHole : single ;                    { Hole size }
    fPortRef : TGUID ;

    procedure SetOffset( const Value : TGPPointF ) ; virtual ;
    function GetLink : TMedaObject ; override ;
    procedure SetPort( const Value : TMedaPort ) ;
    procedure SetHole( const Value : single ) ; virtual ;
    function GetPad( Index : integer ) : TMedaPad ;
    procedure SetPad( Index : integer ; const Value : TMedaPad ) ;
    procedure SetPortRef( const Value : TGUID ) ;
    procedure SetPortRefAsString( const Value : string ) ;
  public
    procedure SetSelection( aFlag : TMedaState ) ; override ;
    function GetIcon : TIconType ; override ;
    function GetText( aColumn : integer ) : string ; override ;
    function CheckType : TCheckType ; override ;
    function GetColor : TGPColor ; override ;
    function Show : TPoint ; override ;
  public
    constructor Create ;
    destructor Destroy ; override ;
    function Accept( Visitor : TObject ) : TObject ; override ;
    function Clone : TMedaObject ; override ;
    procedure Assign( aObject : TMedaObject ) ; override ;
    procedure Vaporize ; override ;

    property Port : TMedaPort read fPort write SetPort ;
    property PortRef : TGUID read FPortRef write SetPortRef ;
    property PortRefAsString : string write SetPortRefAsString ;

    property Offset : TGPPointF read fOffset write SetOffset ;

    property Pad[ Index : integer ] : TMedaPad read GetPad write SetPad ;
    function AddPad : TMedaPad ;
    property Hole : single read fHole write SetHole ;
    procedure LoadPad( aFilename : string ) ;

    procedure LinkPort ; override ;
  end ;

  TMedaPad = class( TMedaVisible )
  private
    fType : TMedaPadType ;
    fSize : TGPSizeF ;

    function GetLink : TMedaObject ; override ;
    procedure SetPadType( const Value : TMedaPadType ) ;
    procedure SetSize( const Value : TGPSizeF ) ;
    procedure Rebuild ; virtual ;
  protected
    function GetOutline : TGPRectF ; override ;
  public
    procedure SetSelection( aFlag : TMedaState ) ; override ;
    function GetText( aColumn : integer ) : string ; override ;
    function CheckType : TCheckType ; override ;
    function GetIcon : TIconType ; override ;
  public
    constructor Create ;
    function Accept( Visitor : TObject ) : TObject ; override ;
    procedure Assign( aObject : TMedaObject ) ; override ;
    function Clone : TMedaObject ; override ;

    procedure Build( aPadType : TMedaPadType ; coor : array of double ) ; reintroduce ; overload ;
    procedure Build( aPadType : TMedaPadType ; aSize : TGPSizeF ) ; reintroduce ; overload ;
    procedure PlaceMe ; override ;

    property PadType : TMedaPadType read fType write SetPadType ;
    property Size : TGPSizeF read fSize write SetSize ;

    function GetConnector( aPoint : TGPPointF ) : TGPPointF ; override ;
  end ;

  // TMedaVia are through hole stacks for nets, not used for devices
  TMedaVia = class( TMedaStack )
  private
  public
    function GetText( aColumn : integer ) : string ; override ;
    function GetIcon : TIconType ; override ;
    function GetColor : TGPColor ; override ;
    function GetLink : TMedaObject ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
    constructor Create ;
  end ;

  // TMedaBlind are blind vias
  TMedaBlind = class( TMedaStack )
  private
  public
    function GetIcon : TIconType ; override ;
    function GetColor : TGPColor ; override ;
    function GetLink : TMedaObject ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  // TMedaBuried are buried vias
  TMedaBuried = class( TMedaStack )
  private
  public
    function GetIcon : TIconType ; override ;
    function GetColor : TGPColor ; override ;
    function GetLink : TMedaObject ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  // TMedaFiducial are fiducials
  TMedaFiducial = class( TMedaStack )
  private
  public
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  // TMedaLabel is a schematic representative of a net
  TMedaLabel = class( TMedaVisible )
  private
    function GetLink : TMedaObject ; override ;
  protected
    procedure BuildPath ; override ;
  public
    function GetText( aColumn : integer ) : string ; override ;
    function CheckType : TCheckType ; override ;
    function GetColor : TGPColor ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
    procedure PlaceMe ; override ;
  end ;

  // TMedaPower is a label for a net with a module port
  // It has its own label type

  TMedaPower = class( TMedaLabel )
  private
    fPowerType : TMedaPowerType ;
    function GetPowerType : TMedaPowerType ;
    procedure SetPowerType( const Value : TMedaPowerType ) ;
    function GetLink : TMedaObject ; override ;
  protected
    procedure BuildPath ; override ;
  public
    function GetColor : TGPColor ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
    property PowerType : TMedaPowerType read GetPowerType write SetPowerType ;
  end ;

  // TMedaCopper is a PCB layer copper pour as a polygon

  TMedaCopper = class( TMedaVisible )
  private
  public
    function GetIcon : TIconType ; override ;
    function CheckType : TCheckType ; override ;
    function GetColor : TGPColor ; override ;
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
    procedure AddPolygon( aPoints : array of TGPPointF ) ; override ;
  end ;

  // some future special groupers

  TMedaGroup = class( TMedaContainer )
  private
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMedaNetBundle = class( TMedaGroup )
  private
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMedaPinBundle = class( TMedaGroup )
  private
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMedaNetBus = class( TMedaGroup )
  private
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  TMedaPinBus = class( TMedaGroup )
  private
  public
    function Accept( Visitor : TObject ) : TObject ; override ;
  end ;

  // TMedaModule is a aggregate of ports, banks and shapes, and other modules or parts.
  // Together they form a virtual thing: a group of parts and modules,
  // or a physical thing: such a group on a PCB, a PCB module

  TMedaModule = class( TMedaPart )
  private
    fModules : TMedaSubContainer ;

    fFiles : TStringList ;              { design files }
    fNetIndex : integer ;
    fPartIndex : integer ;
  public
    function GetIcon : TIconType ; override ;
    function GetColor : TGPColor ; override ;
  public
    constructor Create ;
    destructor Destroy ; override ;
    function Accept( Visitor : TObject ) : TObject ; override ;

    function AddModule : TMedaModule ; virtual ;
    function AddPart : TMedaPart ; virtual ;
    function AddBank : TMedaBank ; override ;
    procedure Remove( aObject : TMedaObject ) ; override ;

    function FirstNet : TMedaPort ;
    function NextNet : TMedaPort ;
    function FirstPart : TMedaPart ;
    function NextPart : TMedaPart ;

    function NetByName( aNet : string ) : TMedaNet ;
    function PortByDesignator( aPart, aPort : string ) : TMedaNet ; overload ;
    function FindPortByGUID( aID : TGUID ) : TMedaNet ;

    procedure BuildBank ; virtual ;
  end ;

  // TMedaProject is the actual project consisting of one or more modules,
  // a set of schematic pages and a PCB

  TMedaProject = class( TMedaContainer )
  private
    fFilename : string ;
    fStale : boolean ;
    fPCB : TVirtScrollBox ;
    fSchematic : TVirtScrollBox ;
    fXML : TFrame ;
    FVST : TBaseVirtualTree ;
    FSortMode : integer ;
    FTreeUpdate : boolean ;

    function GetModule( index : integer ) : TMedaModule ;
    procedure SetPCB( const Value : TVirtScrollBox ) ;
    procedure SetSchematic( const Value : TVirtScrollBox ) ;
    procedure SetXML( const Value : TFrame ) ;
    procedure SetVST( const Value : TBaseVirtualTree ) ;
    procedure SetSortMode( const Value : integer ) ;
    procedure SetTreeUpdate( const Value : boolean ) ;
  protected
    procedure Update ; override ;
    procedure SetStale( const Value : boolean ) ; virtual ;
  public
    function GetText( aColumn : integer ) : string ; override ;
    function GetIcon : TIconType ; override ;
    function GetColor : TGPColor ; override ;
    procedure Sort ; override ;
    property SortMode : integer read FSortMode write SetSortMode ;
  public
    constructor Create ;
    destructor Destroy ; override ;
    function Accept( Visitor : TObject ) : TObject ; override ;

    procedure Clear ; override ;

    property Stale : boolean read fStale write SetStale ;
    property TreeUpdate : boolean read FTreeUpdate write SetTreeUpdate ;
    procedure Modified ;

    property Filename : string read fFileName write fFilename ;
    procedure LoadFromFile( aFilename : string = '' ) ; virtual ;
    procedure SaveToFile( aFilename : string = '' ) ; virtual ;

    property Modules[ index : integer ] : TMedaModule read GetModule ; default ;
    function NewModule : TMedaModule ;

    property Schematic : TVirtScrollBox read fSchematic write SetSchematic ;
    property PCB : TVirtScrollBox read fPCB write SetPCB ;
    property XML : TFrame read fXML write SetXML ;
    property VST : TBaseVirtualTree read fVST write SetVST ;

    procedure SchematicRats( aGraphics : TMedaGraphics ) ;
    procedure PCBRats( aGraphics : TMedaGraphics ) ;
    procedure GetSelectedItems( var aPlacements : TObject ) ;
  end ;

function GetNewDesignator( aType : string ) : string ;

var
  Project           : TMedaProject ;
  SelectedObject    : TMedaObject ;
  SelectedPlace     : TMedaAbstractPlace ;
  SelectedPoint     : TGPPointF ;

implementation

uses
  uMain,
  uPlacement,
  uLayout,
  uViewSchematic,
  uViewPCB,
  uXML,
  uProjEDA,
  uVisitor,
  uViewFactory ;

var
  gDesignators      : TStringlist ;

  gRatsPenSch       : TGPPen ;
  gRatsPenPCB       : TGPPen ;

function GetNewDesignator( aType : string ) : string ;
var
  i, n              : integer ;
begin
  i := gDesignators.IndexOf( aType ) ;
  if i < 0 then
    i := gDesignators.Add( aType ) ;
  n := integer( gDesignators.Objects[ i ] ) + 1 ;
  gDesignators.Objects[ i ] := TObject( n ) ;
  Result := aType + IntToStr( n ) ;
end ;

function CompareSubContainer( Item1, Item2 : Pointer ) : Integer ;
var
  a, b              : TMedaSubContainer ;
begin
  a := TMedaSubContainer( Item1 ) ;
  b := TMedaSubContainer( Item2 ) ;
  Result := a.fSortIndex - b.fSortIndex ;
end ;

{ TMedaProject }

constructor TMedaProject.Create ;
begin
  inherited ;
  Expanded := True ;
end ;

procedure TMedaProject.Clear ;
begin
  inherited ;
  gDesignators.Clear ;
  fFilename := '' ;
  Name := '' ;
  Designator := '' ;
  fStale := False ;
end ;

destructor TMedaProject.Destroy ;
begin
  inherited ;
end ;

function TMedaProject.NewModule : TMedaModule ;
begin
  Result := TMedaModule.Create ;
  fModule := Result ;
  Result.Name := 'Module' ;
  Result.Designator := GetNewDesignator( 'M' ) ;
  Result.Module := nil ;
  Result.Parent := Self ;
  Add( TMedaObject( Result ) ) ;
  Update ;
end ;

function TMedaProject.GetModule( index : integer ) : TMedaModule ;
begin
  Result := nil ;
  if index < fObjects.Count then
    Result := TMedaModule( fObjects[ index ] ) ;
end ;

procedure TMedaProject.SetStale( const Value : boolean ) ;
begin
  fStale := Value ;
end ;

procedure TMedaProject.SetTreeUpdate( const Value : boolean ) ;
begin
  fTreeUpdate := Value ;
end ;

procedure TMedaProject.SetVST( const Value : TBaseVirtualTree ) ;
begin
  FVST := Value ;
end ;

function TMedaProject.GetIcon : TIconType ;
begin
  Result := iconProject ;
end ;

function TMedaProject.GetText( aColumn : integer ) : string ;
begin
  Result := '' ;
  case aColumn of
    0 : Result := GetName ;
    1 : Result := ExtractFileName( fFilename ) ;
    2 : Result := IntToStr( ObjectFactory.Count ) ;
  end ;
end ;

procedure TMedaProject.LoadFromFile( aFilename : string = '' ) ;
begin
  if aFilename <> '' then
    fFilename := aFilename ;
  if assigned( fXML ) then
    ( fXML as TfrmXML ).LoadFromFile( Self, fFilename ) ;
end ;

procedure TMedaProject.Modified ;
begin
  SetStale( True ) ;
end ;

procedure TMedaProject.SaveToFile ;
begin
  if assigned( fXML ) then
    ( fXML as TfrmXML ).SaveToFile( Self, fFilename ) ;
  fStale := False ;
end ;

function TMedaProject.GetColor : TGPColor ;
begin
  Result := aclMedaProject ;
end ;

function TMedaProject.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

procedure TMedaProject.Update ;
begin
  inherited ;
  fTreeUpdate := True ;
  SetStale( True ) ;
end ;

procedure TMedaProject.SchematicRats( aGraphics : TMedaGraphics ) ;
var
  iNet              : TMedaNet ;
  iRats             : TMedaRatsNest ;
  i                 : integer ;
begin
  for i := 0 to fObjects.Count - 1 do
    with Modules[ i ] do begin
      iNet := FirstNet ;
      while assigned( iNet ) do begin
        iRats := iNet.RatsNest ;
        if assigned( iRats ) then
          iRats.PaintAtSchematic( aGraphics, vsbSchematicViewer.CurrentPage ) ;
        iNet := NextNet ;
      end ;
    end ;
end ;

procedure TMedaProject.PCBRats( aGraphics : TMedaGraphics ) ;
var
  iNet              : TMedaNet ;
  iRats             : TMedaRatsNest ;
  i                 : integer ;
begin
  for i := 0 to Count - 1 do
    with Modules[ i ] do begin
      iNet := FirstNet ;
      while assigned( iNet ) do begin
        iRats := iNet.RatsNest ;
        if assigned( iRats ) then
          iRats.PaintAtPCB( aGraphics ) ;
        iNet := NextNet ;
      end ;
    end ;
end ;

procedure TMedaProject.GetSelectedItems( var aPlacements : TObject ) ;
var
  iPart             : TMedaPart ;
  i, j, k, l        : integer ;
begin
  if assigned( aPlacements ) then
    for i := 0 to Count - 1 do
      with Modules[ i ] do begin
        iPart := FirstPart ;
        while assigned( iPart ) do begin
          for j := 0 to iPart.BankCount - 1 do
            for k := 0 to iPart.Banks[ j ].Count - 1 do
              if assigned( iPart.Banks[ j ].Pins[ k ] ) and
                ( iPart.Banks[ j ].Pins[ k ].GetSelection <> triFalse ) then
                ( aPlacements as TMedaViewlist ).Add(
                  TMedaView( iPart.Banks[ j ].Pins[ k ].View ) ) ;
          for j := 0 to iPart.ShapeCount - 1 do
            for k := 0 to iPart.Shapes[ j ].Count - 1 do
              for l := 0 to iPart.Shapes[ j ].Stacks[ k ].Count - 1 do
                if assigned( iPart.Shapes[ j ].Stacks[ k ].Pad[ l ] ) and
                  ( iPart.Shapes[ j ].Stacks[ k ].Pad[ l ].GetSelection <> triFalse ) then
                  ( aPlacements as TMedaViewlist ).Add(
                    TMedaView( iPart.Shapes[ j ].Stacks[ k ].Pad[ l ].View ) ) ;
          iPart := NextPart ;
        end ;
      end ;
end ;

procedure TMedaProject.SetPCB( const Value : TVirtScrollBox ) ;
begin
  fPCB := Value ;
end ;

procedure TMedaProject.SetSchematic( const Value : TVirtScrollBox ) ;
begin
  fSchematic := Value ;
end ;

procedure TMedaProject.SetSortMode( const Value : integer ) ;
begin
  fSortMode := Value ;
end ;

procedure TMedaProject.SetXML( const Value : TFrame ) ;
begin
  fXML := Value ;
end ;

procedure TMedaProject.Sort ;
begin
  inherited ;
  Update ;
end ;

{ TMedaModule }

constructor TMedaModule.Create ;
begin
  inherited Create ;
  fModule := Self ;
  fPorts.Name := 'Nets' ;

  fModules := TMedaSubContainer.Create ;
  fModules.Parent := Self ;
  fModules.Name := 'Modules' ;
  //   Add( TMedaObject( fModules ) ) ;

  fFiles := TStringList.Create ;
  Expanded := True ;
  fNetIndex := -1 ;
end ;

destructor TMedaModule.Destroy ;
begin
  fFiles.Free ;
  inherited ;
end ;

function TMedaModule.AddModule : TMedaModule ;
begin
  Result := TMedaModule.Create ;
  fModules.Add( TMedaObject( Result ) ) ;
  Result.Name := 'ModuleName' ;
  Result.Designator := GetNewDesignator( 'M' ) ;
  Result.Parent := Self ;
  Result.Module := Self ;
end ;

function TMedaModule.AddPart : TMedaPart ;
begin
  Result := TMedaPart.Create ;
  fModules.Add( TMedaObject( Result ) ) ;
  Result.Name := 'PartName' ;
  Result.Designator := GetNewDesignator( 'U' ) ;
  Result.Parent := Self ;
  Result.Module := Self ;
end ;

function TMedaModule.AddBank : TMedaBank ;
begin
  Result := TMedaSymbol.Create ;
  fBanks.Add( TMedaObject( Result ) ) ;
  Result.Name := 'BankName' ;
  Result.Designator := GetNewDesignator( '_b' ) ;
  Result.Parent := Self ;
  Result.Module := Self ;
end ;

function TMedaModule.GetIcon : TIconType ;
begin
  Result := iconModule ;
end ;

function TMedaModule.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

function TMedaModule.FindPortByGUID( aID : TGUID ) : TMedaNet ;
var
  i                 : integer ;
begin
  for i := 0 to fPorts.Count - 1 do
    if assigned( Ports[ i ] ) then begin
      Result := Ports[ i ] ;
      if IsEqualGUID( Result.ID, aID ) then
        Exit ;
    end ;
  Result := nil ;
end ;

function TMedaModule.FirstNet : TMedaPort ;
begin
  fNetIndex := -1 ;
  Result := NextNet ;
end ;

function TMedaModule.NextNet : TMedaPort ;
var
  i                 : integer ;
begin
  Result := nil ;
  for i := fNetIndex + 1 to fPorts.Count - 1 do
    if assigned( fPorts[ i ] ) and ( fPorts[ i ] is TMedaNet ) then begin
      Result := TMedaPort( fPorts[ i ] ) ;
      fNetIndex := i ;
      Exit ;
    end ;
end ;

function TMedaModule.FirstPart : TMedaPart ;
begin
  fPartIndex := -1 ;
  Result := NextPart ;
end ;

function TMedaModule.NextPart : TMedaPart ;
var
  i                 : integer ;
begin
  Result := nil ;
  for i := fPartIndex + 1 to fModules.Count - 1 do
    if assigned( fModules[ i ] ) and ( fModules[ i ] is TMedaPart ) then begin
      Result := TMedaPart( fModules[ i ] ) ;
      fPartIndex := i ;
      Exit ;
    end ;
end ;

function TMedaModule.PortByDesignator( aPart, aPort : string ) : TMedaNet ;
var
  i                 : integer ;
begin
  Result := nil ;
  for i := 0 to fModules.Count - 1 do
    if assigned( fModules[ i ] ) and ( fModules[ i ] is TMedaPart ) and ( fModules[ i ].Designator = aPart ) then begin
      Result := TMedaPart( fModules[ i ] ).PortByDesignator( aPort ) ;
      if assigned( Result ) then
        Break ;
    end ;
end ;

function TMedaModule.NetByName( aNet : string ) : TMedaNet ;
var
  i                 : integer ;
begin
  Result := nil ;
  for i := 0 to fPorts.Count - 1 do
    if assigned( fPorts[ i ] ) and ( fPorts[ i ] is TMedaNet ) and ( TMedaNet( fPorts[ i ] ).Name = aNet ) then begin
      Result := Ports[ i ] ;
      Exit ;
    end ;
end ;

function TMedaModule.GetColor : TGPColor ;
begin
  Result := aclMedaModule ;
end ;

procedure TMedaModule.BuildBank ;
var
  iBank             : TMedaBank ;
  iPin              : TMedaPin ;
  i                 : integer ;
begin
  inherited ;
  iBank := AddBank ;
  for i := 0 to fPorts.Count - 1 do
    if Ports[ i ] is TMedaPort then begin
      iPin := iBank.AddPin ;
      iPin.Name := Ports[ i ].Name ;
      iPin.Designator := Ports[ i ].Designator ;
      if Ports[ i ].Power then
        iPin.PinType := pntPower
      else
        iPin.PinType := pntPortIn ;
      TMedaPort( Ports[ i ] ).Pin := iPin ;
    end ;
  iBank.BuildOutline ;
  Update ;
end ;

procedure TMedaModule.Remove( aObject : TMedaObject ) ;
begin
  if aObject is TMedaPart then
    fModules.Remove( aObject )
  else if aObject is TMedaModule then
    fModules.Remove( aObject )
  else
    inherited ;
end ;

{ TMedaNet }

constructor TMedaNet.Create ;
begin
  inherited Create ;
  fPorts := TMedaRatsNest.Create ;
  Add( TMedaObject( fPorts ) ) ;
  fPorts.Parent := Self ;
  fPorts.Name := 'Nest' ;
  fPorts.fSortIndex := 1 ;

  fWires := TMedaSubContainer.Create ;
  fWires.Parent := Self ;
  fWires.Name := 'Wires' ;
  fWires.fSortIndex := 2 ;

  fLabels := TMedaSubContainer.Create ;
  fLabels.Parent := Self ;
  fLabels.Name := 'Labels' ;
  fLabels.fSortIndex := 3 ;

  fTracks := TMedaSubContainer.Create ;
  fTracks.Parent := Self ;
  fTracks.Name := 'Tracks' ;
  fTracks.fSortIndex := 4 ;

  fPowers := TMedaSubContainer.Create ;
  fPowers.Parent := Self ;
  fPowers.Name := 'Powers' ;
  fPowers.fSortIndex := 5 ;

  fVias := TMedaSubContainer.Create ;
  fVias.Parent := Self ;
  fVias.Name := 'Vias' ;
  fVias.fSortIndex := 6 ;
end ;

procedure TMedaNet.DeleteWires ;
begin
  fWires.RemoveAll ;
  Update ;
end ;

procedure TMedaNet.DeleteTracks ;
begin
  fTracks.RemoveAll ;
  Update ;
end ;

function TMedaNet.ExtractLabel( aObject : TMedaLabel ) : TMedaLabel ;
begin
  Result := fLabels.Extract( aObject ) as TMedaLabel ;
end ;

function TMedaNet.ExtractWire( aObject : TMedaWire ) : TMedaWire ;
begin
  Result := fWires.Extract( aObject ) as TMedaWire ;
end ;

function TMedaNet.ExtractPower( aObject : TMedaPower ) : TMedaPower ;
begin
  Result := fPowers.Extract( aObject ) as TMedaPower ;
end ;

function TMedaNet.ExtractTrack( aObject : TMedaTrack ) : TMedaTrack ;
begin
  Result := fTracks.Extract( aObject ) as TMedaTrack ;
end ;

function TMedaNet.ExtractVia( aObject : TMedaVia ) : TMedaVia ;
begin
  Result := fVias.Extract( aObject ) as TMedaVia ;
end ;

function TMedaNet.ExtractPort( aObject : TMedaPort ) : TMedaPort ;
begin
  Result := fPorts.Extract( aObject ) as TMedaPort ;
end ;

procedure TMedaNet.Join( aNet : TMedaNet ) ;
var
  iObject           : TMedaObject ;
  i                 : integer ;
begin
  if ( not assigned( aNet ) ) or ( aNet = Self ) then
    Exit ;
  // join other net to us by:
  // move all lines, labels, traces and vias
  for i := aNet.WireCount - 1 downto 0 do begin
    iObject := aNet.ExtractWire( aNet.Wires[ i ] ) ;
    Assert( assigned( iObject ) ) ;
    Assert( iObject is TMedaWire ) ;
    fWires.Add( iObject ) ;
  end ;
  for i := aNet.LabelCount - 1 downto 0 do begin
    iObject := aNet.ExtractLabel( aNet.Labels[ i ] ) ;
    Assert( assigned( iObject ) ) ;
    Assert( iObject is TMedaLabel ) ;
    fLabels.Add( iObject ) ;
  end ;
  for i := aNet.TrackCount - 1 downto 0 do begin
    iObject := aNet.ExtractTrack( aNet.Tracks[ i ] ) ;
    Assert( assigned( iObject ) ) ;
    Assert( iObject is TMedaTrack ) ;
    fTracks.Add( iObject ) ;
  end ;
  for i := aNet.ViaCount - 1 downto 0 do begin
    iObject := aNet.ExtractVia( aNet.Vias[ i ] ) ;
    Assert( assigned( iObject ) ) ;
    Assert( iObject is TMedaVia ) ;
    fVias.Add( iObject ) ;
  end ;
  // move all ports
  for i := aNet.PortCount - 1 downto 0 do begin
    iObject := aNet.ExtractPort( aNet.Ports[ i ] ) ;
    Assert( assigned( iObject ) ) ;
    Assert( iObject is TMedaPort ) ;
    ConnectPort( TMedaPort( iObject ) ) ;
  end ;
  Update ;
end ;

function TMedaNet.GetText( aColumn : integer ) : string ;
begin
  Result := '' ;
  case aColumn of
    0 : Result := GetName ;
    1 : Result := GetDesignator ;
  end ;
end ;

function TMedaNet.GetTracks( index : integer ) : TMedaTrack ;
begin
  Assert( index < fTracks.Count ) ;
  Result := fTracks[ index ] as TMedaTrack ;
end ;

function TMedaNet.GetVias( index : integer ) : TMedaVia ;
begin
  Assert( index < fVias.Count ) ;
  Result := fVias[ index ] as TMedaVia ;
end ;

function TMedaNet.GetSchematicPoints : TMedaWirePoints ;
begin
  Result := TMedaWirePoints.Create ;
end ;

function TMedaNet.IsPort : boolean ;
begin
  Result := Self is TMedaPort ;
end ;

function TMedaNet.GetIcon : TIconType ;
begin
  Result := iconNet ;
end ;

function TMedaNet.GetLabels( index : integer ) : TMedaLabel ;
begin
  Assert( index < fLabels.Count ) ;
  Result := fLabels[ index ] as TMedaLabel ;
end ;

function TMedaNet.GetLines( index : integer ) : TMedaWire ;
begin
  Assert( index < fWires.Count ) ;
  Result := fWires[ index ] as TMedaWire ;
end ;

procedure TMedaNet.Add( var aObject : TMedaObject ) ;
begin
  inherited ;
  fObjects.Sort( CompareSubContainer ) ;
end ;

function TMedaNet.AddLabel : TMedaLabel ;
begin
  Result := TMedaLabel.Create ;
  fLabels.Add( TMedaObject( Result ) ) ;
  Result.Name := Name ;
  Result.Designator := GetNewDesignator( '_a' ) ;
  Result.Parent := Self ;
  Result.SetSelection( GetSelection ) ;
  Result.Module := fModule ;
  Update ;
end ;

function TMedaNet.AddPower : TMedaPower ;
begin
  Result := TMedaPower.Create ;
  fPowers.Add( TMedaObject( Result ) ) ;
  Result.Name := Name ;
  Result.Designator := GetNewDesignator( '_w' ) ;
  Result.Parent := Self ;
  Result.SetSelection( GetSelection ) ;
  Result.Module := fModule ;
  Power := True ;
  Update ;
end ;

function TMedaNet.AddWire : TMedaWire ;
begin
  Result := TMedaWire.Create ;
  fWires.Add( TMedaObject( Result ) ) ;
  Result.Name := 'Wire' ;
  Result.Designator := GetNewDesignator( '_w' ) ;
  Result.Parent := Self ;
  Result.SetSelection( GetSelection ) ;
  Result.Module := fModule ;
  Update ;
end ;

function TMedaNet.AddTrack : TMedaTrack ;
begin
  Result := TMedaTrack.Create ;
  fTracks.Add( TMedaObject( Result ) ) ;
  Result.Name := 'Track' ;
  Result.Designator := GetNewDesignator( '_t' ) ;
  Result.Parent := Self ;
  Result.SetSelection( GetSelection ) ;
  Result.Module := fModule ;
  Update ;
end ;

function TMedaNet.AddVia : TMedaVia ;
begin
  Result := TMedaVia.Create ;
  fVias.Add( TMedaObject( Result ) ) ;
  Result.Name := 'Via' ;
  Result.Designator := GetNewDesignator( '_v' ) ;
  Result.Parent := Self ;
  Result.SetSelection( GetSelection ) ;
  Result.Module := fModule ;
  Update ;
end ;

function TMedaNet.GetColor : TGPColor ;
begin
  Result := aclMedaNet ;
end ;

procedure TMedaNet.ConnectPort( aPort : TMedaPort ) ;
begin
  if assigned( aPort ) and ( fPorts.fObjects.IndexOf( aPort ) < 0 ) then begin
    aPort.fNet := Self ;
    fPorts.Add( TMedaObject( aPort ) ) ;
  end ;
end ;

function TMedaNet.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

function TMedaNet.LabelCount : integer ;
begin
  Result := fLabels.Count ;
end ;

function TMedaNet.WireCount : integer ;
begin
  Result := fWires.Count ;
end ;

procedure TMedaNet.SchematicPointMoved( const aFrom, aTo : TGPPointF ) ;
var
  i                 : integer ;
begin
  for i := 0 to WireCount - 1 do
    Wires[ i ].MovePoint( aFrom, aTo ) ;
end ;

function TMedaNet.PortCount : integer ;
begin
  Result := fPorts.Count ;
end ;

function TMedaNet.PowerCount : integer ;
begin
  Result := fPowers.Count ;
end ;

function TMedaNet.TrackCount : integer ;
begin
  Result := fTracks.Count ;
end ;

function TMedaNet.ViaCount : integer ;
begin
  Result := fVias.Count ;
end ;

procedure TMedaNet.SetPower( const Value : boolean ) ;
begin
  if Value then
    Include( fFlags, vfPower )
  else
    Exclude( fFlags, vfPower ) ;
end ;

function TMedaNet.GetPorts( index : integer ) : TMedaPort ;
begin
  Result := fPorts[ index ] as TMedaPort ;
end ;

function TMedaNet.GetPower : boolean ;
begin
  Result := vfPower in fFlags ;
end ;

function TMedaNet.GetPowers( index : integer ) : TMedaPower ;
begin
  Assert( index < fPowers.Count ) ;
  Result := fPowers[ index ] as TMedaPower ;
end ;

{procedure TMedaNet.GatherLines( aPlace : TMedaViewable ) ;
var
    i, j, k, n, p, q : integer ;
    iLine           : TMedaWire ;
    iPoint          : TGPPointF ;
    iPoints         : array of TGPPointF ;
    iGraph          : array of array of boolean ;
    iTrans          : TMedaTransform ;

    function Locate( aTrans : TMedaTransform ; aPoint : TGPPointF ) : TGPPointF ;
    begin
        Result := aPoint ;
        case aTrans.Rotation of
            drEast : ;
            drNorth : begin
                    Result.X := aPoint.Y ;
                    Result.Y := -aPoint.X ;
                end ;
            drWest : begin
                    Result.X := -aPoint.X ;
                    Result.Y := -aPoint.Y ;
                end ;
            drSouth : begin
                    Result.X := -aPoint.Y ;
                    Result.Y := aPoint.X ;
                end ;
        end ;
        if aTrans.Mirror then
            Result.X := -Result.X ;
        Result.X := Result.X + aTrans.Position.X ;
        Result.Y := Result.Y + aTrans.Position.Y ;
    end ;

    function IndexOf( aPoint : TGPPointF ) : integer ;
    var
        i           : integer ;
    begin
        for i := 0 to length( iPoints ) - 1 do
            if ( aPoint.X = iPoints[ i ].X ) and ( aPoint.Y = iPoints[ i ].Y ) then begin
                Result := i ;
                Exit ;
            end ;
        Result := -1 ;
    end ;
begin
    iPoints := nil ;
    iGraph := nil ;
    try
        for i := 0 to fLines.Count - 1 do begin
            // record all unique points
            iLine := TMedaWire( fLines[ i ] ) ;
            if iLine.PlacedAt( aPlace ) then
                for j := 0 to iLine.Count - 1 do begin
                    iPoint := Locate( iLine.Transforms[ 0 ], iLine.Points[ j ] ) ;
                    if IndexOf( iPoint ) < 0 then begin
                        n := length( iPoints ) ;
                        Setlength( iPoints, n + 1 ) ;
                        iPoints[ n ] := iPoint ;
                    end ;
                end ;
        end ;

        // build adjacency matrix
        n := length( iPoints ) ;
        Setlength( iGraph, n ) ;
        for i := 0 to n - 1 do
            Setlength( iGraph[ i ], n ) ;

        // fill adjacency matrix
        for i := 0 to fLines.Count - 1 do begin
            iLine := TMedaWire( fLines[ i ] ) ;
            if iLine.PlacedAt( aPlace ) and ( iLine.Count > 0 ) then begin
                iPoint := Locate( iLine.Transforms[ 0 ], iLine.Points[ 0 ] ) ;
                p := IndexOf( iPoint ) ;
                for j := 1 to iLine.Count - 1 do begin
                    iPoint := Locate( iLine.Transforms[ 0 ], iLine.Points[ j ] ) ;
                    q := IndexOf( iPoint ) ;
                    iGraph[ p, q ] := True ;
                    iGraph[ q, p ] := True ;
                    p := q ;
                end ;
            end ;
        end ;
        for i := 0 to n - 1 do begin
            k := 0 ;
            for j := 0 to n - 1 do
                if iGraph[ i, j ] then
                    inc( k ) ;
            if k > 2 then begin
                iLine := AddLine ;
                iTrans.Position := iPoints[ i ] ;
                iTrans.Mirror := False ;
                iTrans.Rotation := drEast ;
                iLine.Place( aPlace, iTrans ) ;
            end ;
        end ;
    finally
        iGraph := nil ;
        iPoints := nil ;
    end ;
end ;}

procedure TMedaNet.Remove( aObject : TMedaObject ) ;
begin
  if aObject is TMedaPort then
    fPorts.Remove( aObject )
  else if aObject is TMedaTrack then
    fTracks.Remove( aObject )
  else if aObject is TMedaVia then
    fVias.Remove( aObject )
  else if aObject is TMedaWire then
    fWires.Remove( aObject )
  else if aObject is TMedaPower then
    fPowers.Remove( aObject )
  else if aObject is TMedaLabel then
    fLabels.Remove( aObject )
  else
    fObjects.Remove( aObject ) ;
  Update ;
end ;

procedure TMedaNet.SetPortType( const Value : TMedaPortType ) ;
begin
  fPortType := Value ;
end ;

{ TMedaPort }

function TMedaPort.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

procedure TMedaPort.Assign( aObject : TMedaObject ) ;
var
  iPort             : TMedaPort ;
begin
  inherited ;
  if assigned( aObject ) then begin
    iPort := aObject as TMedaPort ;
    fPin := iPort.Pin ;
    fStack := iPort.Stack ;
    fNet := iPort.Net ;
  end ;
end ;

function TMedaPort.Clone : TMedaObject ;
begin
  Result := TMedaPort.Create ;
end ;

procedure TMedaPort.Vaporize ;
begin
  inherited ;
  if assigned( fStack ) then
    fStack.fPort := nil ;
  fStack := nil ;

  if assigned( fPin ) then
    fPin.fPort := nil ;
  fPin := nil ;

  fNet := nil ;
end ;

function TMedaPort.GetColor : TGPColor ;
begin
  Result := aclMedaPort ;
end ;

function TMedaPort.GetChildCount : integer ;
begin
  Result := 0 ;
  if assigned( fPin ) then
    inc( Result ) ;
  if assigned( fStack ) then
    inc( Result ) ;
  if fParent is TMedaModule then
    Result := inherited GetCount + Result ;
end ;

function TMedaPort.GetIcon : TIconType ;
begin
  Result := iconPort ;
end ;

function TMedaPort.GetNet : TMedaNet ;
begin
  Result := fNet ;
end ;

function TMedaPort.GetPin : TMedaPin ;
begin
  Result := fPin ;
end ;

function TMedaPort.GetStack : TMedaStack ;
begin
  Result := fStack ;
end ;

procedure TMedaPort.SetParent( const Value : TMedaContainer ) ;
begin
  inherited ;
end ;

procedure TMedaPort.SetPin( const Value : TMedaPin ) ;
begin
  fPin := Value ;
  if assigned( Value ) then begin
    Value.Port := Self ;
    Value.Name := Name ;
    Value.Designator := Designator ;
  end ;
end ;

procedure TMedaPort.SetStack( const Value : TMedaStack ) ;
begin
  fStack := Value ;
  if assigned( Value ) then
    Value.Port := Self ;
end ;

procedure TMedaPort.SetNet( const Value : TMedaNet ) ;
begin
  if assigned( Value ) then
    Value.ConnectPort( Self )
  else
    fNet := nil ;
end ;

function TMedaPort.GetChild( index : integer ) : TMedaViewable ;
begin
  case index of
    0 : if assigned( fPin ) then
        Result := fPin
      else if assigned( fStack ) then
        Result := fStack
      else
        Result := inherited GetChild( 0 ) ;
    1 : if assigned( fPin ) then begin
        if assigned( fStack ) then
          Result := fStack
        else
          Result := inherited GetChild( 0 ) ;
      end
      else if assigned( fStack ) then
        Result := inherited GetChild( 0 )
      else
        Result := inherited GetChild( 1 ) ;
  else
    if assigned( fPin ) then begin
      if assigned( fStack ) then
        Result := inherited GetChild( index - 2 )
      else
        Result := inherited GetChild( index - 1 ) ;
    end
    else
      Result := inherited GetChild( index ) ;
  end ;
end ;

function TMedaPort.GetText( aColumn : integer ) : string ;
begin
  Result := '' ;
  case aColumn of
    0 : Result := GetName ;
    1 : Result := Designator ;
    2 : Result := GetPortType( PortType ) ;
  end ;
end ;

procedure TMedaPort.Invalidate ;
begin
  inherited ;
  if assigned( fPin ) then
    fPin.Invalidate ;
  if assigned( fStack ) then
    fStack.Invalidate ;
end ;

{ TMedaShape }

function TMedaShape.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

function TMedaShape.AddStack : TMedaStack ;
begin
  Result := TMedaStack.Create ;
  Add( TMedaObject( Result ) ) ;
  Result.Name := 'Stack' ;
  Result.Designator := GetNewDesignator( '_s' ) ;
  Result.Module := fModule ;
  Result.Parent := Self ;
  Result.PlaceRef := PlaceRef ;
  Result.Transforms[ 0 ] := Transforms[ 0 ] ;
  Result.Offset := MakePoint( 200.0, 200.0 ) ;
end ;

procedure TMedaShape.CloneStack( aStack : TMedaStack ) ;
var
  iStack            : TMedaStack ;
begin
  iStack := aStack.Clone as TMedaStack ;
  Add( TMedaObject( iStack ) ) ;
  iStack.Module := fModule ;
  iStack.Parent := Self ;
  iStack.Assign( aStack ) ;
  iStack := nil ;
end ;

constructor TMedaShape.Create ;
begin
  inherited ;
  Name := 'Footprint' ;
  fDesignator := 'A' ;
end ;

function TMedaShape.GetIcon : TIconType ;
begin
  Result := iconFootprint ;
end ;

function TMedaShape.GetText( aColumn : integer ) : string ;
begin
  Result := inherited GetText( aColumn ) ;
  case aColumn of
    3 : if assigned( fParent ) then
        Result := fParent.Name ;
    4 : if assigned( fParent ) then
        Result := fParent.Designator ;
  end ;
end ;

function TMedaShape.StackByDesignator( aDesignator : string ) : TMedaStack ;
var
  i                 : integer ;
begin
  for i := 0 to Count - 1 do
    if Stacks[ i ].Designator = aDesignator then begin
      Result := Stacks[ i ] ;
      Exit ;
    end ;
  Result := nil ;
end ;

function TMedaShape.StackCount : integer ;
begin
  Result := Count ;
end ;

procedure TMedaShape.PlaceMe ;
var
  iLayer            : TGUID ;
begin
  iLayer := fPlaceRef ;
  fPlaceRef := vsbPCBViewer.AllLayers[ lcMechanical ].ID ;
  try
    inherited PlaceMe ;
  finally
    fPlaceRef := iLayer ;
  end ;
end ;

procedure TMedaShape.LoadStack( aFilename : string ) ;
begin
end ;

function TMedaShape.GetStacks( index : integer ) : TMedaStack ;
begin
  Result := TMedaStack( GetObjects( index ) ) ;
end ;

procedure TMedaShape.SetStacks( index : integer ; const Value : TMedaStack ) ;
begin
  SetObjects( index, Value ) ;
end ;

function TMedaShape.CheckType : TCheckType ;
begin
  Result := ctCheckbox ;
end ;

function TMedaShape.GetChildCount : integer ;
begin
  Result := 0 ;
end ;

function TMedaShape.GetColor : TGPColor ;
begin
  Result := aclMedaShape ;
end ;

procedure TMedaShape.SetOutline( const Value : TGPRectF ) ;
begin
  if assigned( fPath ) then
    fPath.Reset ;
  AddRectangle( Value.X, Value.Y, Value.X + Value.Width, Value.Y + Value.Height ) ;
  fTransforms[ 1 ].Position := MakePoint( Value.X, Value.Y - 12 ) ;
  fTransforms[ 2 ].Position := MakePoint( Value.X, Value.Y + Value.Height + 12 ) ;
end ;

function TMedaShape.GetLink : TMedaObject ;
begin
  Result := nil ;
  if assigned( fParent ) then
    Result := ( fParent as TMedaPart ).FirstBank ;
end ;

{ TMedaPart }

function TMedaPart.GetIcon : TIconType ;
begin
  Result := iconPart ;
end ;

function TMedaPart.GetNets( index : integer ) : TMedaNet ;
begin
  Result := nil ;
  if index < fPorts.Count then
    Result := TMedaNet( fPorts[ index ] ) ;
end ;

function TMedaPart.GetBank( aMap : string ) : TMedaBank ;
var
  i                 : integer ;
begin
  Result := nil ;
  for i := 0 to fBanks.Count - 1 do
    if assigned( Banks[ i ] ) and
      ( ( aMap = '' ) or ( Banks[ i ].Name = aMap ) ) then begin
      Result := Banks[ i ] ;
      Exit ;
    end ;
end ;

function TMedaPart.AddPort : TMedaPort ;
begin
  Result := TMedaPort.Create ;
  fPorts.Add( TMedaObject( Result ) ) ;
  Result.Name := 'Port' ;
  Result.Designator := GetNewDesignator( '_p' ) ;
  Result.Module := fModule ;
  Result.Parent := Self ;
  Result.PortType := pntNone ;
end ;

procedure TMedaPart.Add( var aObject : TMedaObject ) ;
begin
  inherited ;
  fObjects.Sort( CompareSubContainer ) ;
end ;

function TMedaPart.AddBank : TMedaBank ;
begin
  Result := TMedaBank.Create ;
  fBanks.Add( TMedaObject( Result ) ) ;
  Result.Name := 'BankName' ;
  Result.Designator := GetNewDesignator( '_b' ) ;
  Result.Module := fModule ;
  Result.Parent := Self ;
end ;

function TMedaPart.AddNet : TMedaNet ;
begin
  Result := TMedaNet.Create ;
  fPorts.Add( TMedaObject( Result ) ) ;
  Result.Name := 'Net' ;
  Result.Designator := GetNewDesignator( '_n' ) ;
  if fModule = nil then
    Result.Module := TMedaModule( Self )
  else
    Result.Module := fModule ;
  Result.Parent := Self ;
end ;

function TMedaPart.AddShape : TMedaShape ;
begin
  Result := TMedaShape.Create ;
  fShapes.Add( TMedaObject( Result ) ) ;
  Result.Name := 'FootprintName' ;
  Result.Designator := GetNewDesignator( '_f' ) ;
  Result.Module := fModule ;
  Result.Parent := Self ;
end ;

function TMedaPart.GetText( aColumn : integer ) : string ;
begin
  case aColumn of
    3 : Result := GetName ;
  else
    Result := inherited GetText( aColumn ) ;
  end ;
end ;

procedure TMedaPart.LoadBank( aFilename : string ) ;
begin
  if assigned( Project.XML ) then
    ( Project.XML as TfrmXML ).LoadBank( Self, aFilename ) ;
end ;

procedure TMedaPart.LoadShape( aFilename : string ) ;
begin
  if assigned( Project.XML ) then
    ( Project.XML as TfrmXML ).LoadShape( Self, aFilename ) ;
end ;

function TMedaPart.NetCount : integer ;
begin
  Result := fPorts.Count ;
end ;

function TMedaPart.GetColor : TGPColor ;
begin
  Result := aclMedaPart ;
end ;

function TMedaPart.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

constructor TMedaPart.Create ;
begin
  inherited ;
  fPorts := TMedaSubContainer.Create ;
  fPorts.Parent := Self ;
  fPorts.Name := 'Ports' ;
  fPorts.fSortIndex := 1 ;
  //   Add( TMedaObject( fPorts ) ) ;

  fBanks := TMedaSubContainer.Create ;
  fBanks.Parent := Self ;
  fBanks.Name := 'Banks' ;
  fBanks.fSortIndex := 2 ;
  //   Add( TMedaObject( fBanks ) ) ;

  fShapes := TMedaSubContainer.Create ;
  fShapes.Parent := Self ;
  fShapes.Name := 'Footprints' ;
  fShapes.fSortIndex := 3 ;
  //   Add( TMedaObject( fShapes ) ) ;

  Expanded := False ;
end ;

function TMedaPart.FirstBank : TMedaBank ;
begin
  Result := nil ;
  if BankCount > 0 then
    Result := Banks[ 0 ] ;
end ;

function TMedaPart.FirstShape : TMedaShape ;
begin
  Result := nil ;
  if ShapeCount > 0 then
    Result := Shapes[ 0 ] ;
end ;

function TMedaPart.Clone : TMedaObject ;
begin
  Result := TMedaPart.Create ;
end ;

procedure TMedaPart.Assign( aObject : TMedaObject ) ;
var
  i                 : integer ;
  iPart             : TMedaPart ;
begin
  inherited ;

  Assert( aObject is TMedaPart, 'TMedaPart.Assign' ) ;

  iPart := TMedaPart( aObject ) ;

  for i := 0 to iPart.fPorts.Count - 1 do
    AddPort.Assign( iPart.Ports[ i ] ) ;

  for i := 0 to iPart.fBanks.Count - 1 do
    AddBank.Assign( iPart.Banks[ i ] ) ;

  for i := 0 to iPart.fShapes.Count - 1 do
    AddShape.Assign( iPart.Shapes[ i ] ) ;
end ;

function TMedaPart.PortCount : integer ;
begin
  Result := fPorts.Count ;
end ;

procedure TMedaPart.PlaceMe ;
var
  i                 : integer ;
begin
  for i := 0 to fBanks.Count - 1 do
    Banks[ i ].PlaceMe ;
  for i := 0 to fShapes.Count - 1 do
    Shapes[ i ].PlaceMe ;
end ;

function TMedaPart.PortByName( aName : string ) : TMedaNet ;
var
  i                 : integer ;
begin
  Result := nil ;
  for i := 0 to fPorts.Count - 1 do
    if assigned( fPorts[ i ] ) and ( fPorts[ i ].Name = aName ) then begin
      Result := Ports[ i ] ;
      Break ;
    end ;
end ;

function TMedaPart.PortByDesignator( aDesignator : string ) : TMedaNet ;
var
  i                 : integer ;
begin
  Result := nil ;
  for i := 0 to fPorts.Count - 1 do
    if assigned( fPorts[ i ] ) and ( fPorts[ i ].Designator = aDesignator ) then begin
      Result := Ports[ i ] ;
      Break ;
    end ;
end ;

function TMedaPart.PortByGUID( hPort : TGUID ) : TMedaPort ;
var
  i                 : integer ;
begin
  Result := nil ;
  for i := 0 to fPorts.Count - 1 do
    if assigned( fPorts[ i ] ) and IsEqualGUID( fPorts[ i ].ID, hPort ) then begin
      Result := Ports[ i ] as TMedaPort ;
      Break ;
    end ;
end ;

function TMedaPart.GetBanks( index : integer ) : TMedaBank ;
begin
  Result := nil ;
  if index < fBanks.Count then
    Result := TMedaBank( fBanks[ index ] ) ;
end ;

function TMedaPart.GetPorts( index : integer ) : TMedaPort ;
begin
  Result := nil ;
  if index < fPorts.Count then
    Result := TMedaPort( fPorts[ index ] ) ;
end ;

function TMedaPart.GetShapes( index : integer ) : TMedaShape ;
begin
  Result := nil ;
  if index < fShapes.Count then
    Result := TMedaShape( fShapes[ index ] ) ;
end ;

procedure TMedaPart.SetBanks( index : integer ; const Value : TMedaBank ) ;
begin
  if index < fBanks.Count then
    fBanks[ index ] := Value ;
end ;

procedure TMedaPart.SetNets( index : integer ; const Value : TMedaNet ) ;
begin
  if index < fPorts.Count then
    fPorts[ index ] := Value ;
end ;

procedure TMedaPart.SetPorts( index : integer ; const Value : TMedaPort ) ;
begin
  if index < fPorts.Count then
    fPorts[ index ] := Value ;
end ;

procedure TMedaPart.SetShapes( index : integer ; const Value : TMedaShape ) ;
begin
  if index < fShapes.Count then
    fShapes[ index ] := Value ;
end ;

function TMedaPart.ShapeCount : integer ;
begin
  Result := fShapes.Count ;
end ;

procedure TMedaPart.UpdatePorts( const aBank : TMedaBank ) ;
var
  iPin              : TMedaPin ;
  iPort             : TMedaNet ;

  i                 : integer ;
begin
  if not assigned( aBank ) then
    Exit ;

  for i := 0 to aBank.Count - 1 do begin
    iPin := aBank.Pins[ i ] ;
    iPort := PortByGUID( iPin.PortRef ) ;
    if not assigned( iPort ) then
      iPort := PortByDesignator( iPin.Designator ) ;
    if not assigned( iPort ) then begin
      iPort := AddPort ;
      iPort.Name := iPin.Name ;
      iPort.Designator := iPin.Designator ;
    end ;
    if iPin.PinType = pntNone then
      iPin.PinType := iPort.PortType
    else if iPort.PortType = pntNone then
      iPort.PortType := iPin.PinType ;

    if iPort is TMedaPort then
      TMedaPort( iPort ).Pin := iPin ;
  end ;
end ;

procedure TMedaPart.UpdatePorts( const aShape : TMedaShape ) ;
var
  iStack            : TMedaStack ;
  iPort             : TMedaNet ;

  i                 : integer ;
begin
  if not assigned( aShape ) then
    Exit ;

  for i := 0 to aShape.Count - 1 do begin
    iStack := aShape.Stacks[ i ] ;
    iPort := PortByGUID( iStack.PortRef ) ;
    if not assigned( iPort ) then
      iPort := PortByDesignator( iStack.Designator ) ;
    if not assigned( iPort ) then begin
      iPort := AddPort ;
      iPort.Name := iStack.Name ;
      iPort.Designator := iStack.Designator ;
    end ;
    if iPort is TMedaPort then
      TMedaPort( iPort ).Stack := iStack ;
  end ;
end ;

procedure TMedaPart.UpdatePorts ;
var
  i                 : integer ;
begin
  for i := 0 to fBanks.Count - 1 do
    UpdatePorts( Banks[ i ] ) ;
  for i := 0 to fShapes.Count - 1 do
    UpdatePorts( Shapes[ i ] ) ;
end ;

procedure TMedaPart.Remove( aObject : TMedaObject ) ;
begin
  if aObject is TMedaPort then
    fPorts.Remove( aObject )
  else if aObject is TMedaNet then
    fPorts.Remove( aObject )
  else if aObject is TMedaBank then
    fBanks.Remove( aObject )
  else if aObject is TMedaShape then
    fShapes.Remove( aObject )
  else
    fObjects.Remove( aObject ) ;
end ;

function TMedaPart.BankByName( const aGate : string ) : TMedaBank ;
begin
  Result := GetBank( aGate ) ;
end ;

function TMedaPart.BankCount : integer ;
begin
  Result := fBanks.Count ;
end ;

{ TMedaBank }

function TMedaBank.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

function TMedaBank.AddPin : TMedaPin ;
begin
  Result := TMedaPin.Create ;
  Result.Name := 'Pin' ;
  Result.Designator := GetNewDesignator( '_q' ) ;
  Result.Module := fModule ;
  Result.Parent := Self ;
  Result.PlaceRef := PlaceRef ;
  Result.Transforms[ 0 ] := Transforms[ 0 ] ;
  Result.Flags := [ vfDesignator, vfName, vfBody ] ;
  Add( TMedaObject( Result ) ) ;
end ;

procedure TMedaBank.BuildOutline ;
var
  i                 : integer ;
  n                 : integer ;
  e                 : integer ;
  s                 : integer ;
  w                 : integer ;
  p                 : TGPPointF ;
  r                 : TGPRectF ;
  iPin              : TMedaPin ;
begin
  if Outline.Width < cSchGrid then begin
    n := 0 ;
    e := 0 ;
    s := 0 ;
    w := 0 ;
    for i := 0 to fObjects.Count - 1 do begin
      iPin := TMedaPin( Objects[ i ] ) ;
      case iPin.fDirection of
        drEast : inc( e ) ;
        drNorth : inc( n ) ;
        drWest : inc( w ) ;
        drSouth : inc( s ) ;
      end ;
    end ;

    r.X := -( max( n, s ) + 10 ) div 2 * cSchGrid ;
    r.Y := -( max( e, w ) + 10 ) div 2 * cSchGrid ;
    r.Width := abs( r.X * 2 ) ;
    r.Height := abs( r.Y * 2 ) ;
    Outline := r ;
  end
  else
    r := Outline ;

  n := 5 ;
  e := 5 ;
  s := 5 ;
  w := 5 ;
  for i := 0 to fObjects.Count - 1 do begin
    iPin := Objects[ i ] as TMedaPin ;
    with r do begin
      case iPin.fDirection of
        drNorth : begin
            p := MakePoint( n * cSchGrid + X, Y ) ;
            inc( n ) ;
          end ;
        drEast : begin
            p := MakePoint( Width + X, e * cSchGrid + Y ) ;
            inc( e ) ;
          end ;
        drSouth : begin
            p := MakePoint( s * cSchGrid + X, Height + Y ) ;
            inc( s ) ;
          end ;
        drWest : begin
            p := MakePoint( X, w * cSchGrid + Y ) ;
            inc( w ) ;
          end ;
      end ;
      iPin.Offset := p ;
    end ;
  end ;
end ;

procedure TMedaBank.Assign( aObject : TMedaObject ) ;
var
  i                 : integer ;
  iBank             : TMedaBank ;
begin
  inherited ;
  if assigned( aObject ) then begin
    iBank := aObject as TMedaBank ;
    for i := 0 to iBank.Count - 1 do
      AddPin.Assign( iBank.Pins[ i ] ) ;
  end ;
end ;

constructor TMedaBank.Create ;
begin
  inherited ;
  Name := 'Bank' ;
  fDesignator := 'A' ;
  fTransforms[ 2 ].Position.Y := cSchGrid ;
  fFlags := [ vfDesignator, vfName, vfBody ] ;
end ;

function TMedaBank.Clone : TMedaObject ;
begin
  Result := TMedaBank.Create ;
end ;

procedure TMedaBank.SetOutline( const Value : TGPRectF ) ;
begin
  fPath.Reset ;
  AddRectangle( Value.X, Value.Y, Value.X + Value.Width, Value.Y + Value.Height ) ;
  fTransforms[ 1 ].Position := MakePoint( Value.X, Value.Y - cSchGrid ) ;
  fTransforms[ 2 ].Position := MakePoint( Value.X, Value.Y + Value.Height ) ;
end ;

function TMedaBank.GetIcon : TIconType ;
begin
  Result := iconBank ;
end ;

function TMedaBank.GetPins( index : integer ) : TMedaPin ;
begin
  Result := TMedaPin( GetObjects( index ) ) ;
end ;

function TMedaBank.GetText( aColumn : integer ) : string ;
begin
  Result := '??' ;
  case aColumn of
    0 : Result := Name ;
    1 : Result := Designator ;
    3 : if assigned( fParent ) then
        Result := fParent.Name ;
    4 : if assigned( fParent ) then
        Result := fParent.Designator + ' {' + Name + '}' ;
  else
    Result := inherited GetText( aColumn ) ;
  end ;
end ;

function TMedaBank.CheckType : TCheckType ;
begin
  Result := ctTristateCheckbox ;
end ;

procedure TMedaBank.SetPins( index : integer ; const Value : TMedaPin ) ;
begin
  SetObjects( index, Value ) ;
end ;

function TMedaBank.PinByDesignator( aDesignator : string ) : TMedaPin ;
var
  i                 : integer ;
begin
  Result := nil ;
  for i := 0 to Count - 1 do
    if assigned( Pins[ i ] ) and ( Pins[ i ].Designator = aDesignator ) then begin
      Result := Pins[ i ] ;
      Break ;
    end ;
end ;

function TMedaBank.GetChildCount : integer ;
begin
  Result := 0 ;
end ;

function TMedaBank.GetColor : TGPColor ;
begin
  Result := aclMedaBank ;
end ;

function TMedaBank.GetLink : TMedaObject ;
begin
  Result := ( fParent as TMedaPart ).FirstShape ;
end ;

{ TMedaSymbol }

procedure TMedaSymbol.SetOutline( const Value : TGPRectF ) ;
begin
  AddRoundRect( Value.X, Value.Y, Value.X + Value.Width, Value.Y + Value.Height, cSchGrid ) ;
  Invalidate ;
end ;

{ TMedaPin }

function TMedaPin.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

procedure TMedaPin.Assign( aObject : TMedaObject ) ;
begin
  inherited ;
  if assigned( aObject ) then begin
    Assert( aObject is ClassType ) ;
    fSize := TMedaPin( aObject ).Size ;
    fDirection := TMedaPin( aObject ).Direction ;
    fPortRef := TMedaPin( aObject ).PortRef ;
    PinType := TMedaPin( aObject ).PinType ;
    Offset := TMedaPin( aObject ).Offset ;
  end ;
end ;

procedure TMedaPin.Build( aRotation : TMedaDir ; aType : TMedaPortType ) ;
begin
  Direction := aRotation ;
  PinType := aType ;
  Invalidate ;
end ;

function TMedaPin.Clone : TMedaObject ;
begin
  Result := TMedaPin.Create ;
end ;

constructor TMedaPin.Create ;
begin
  inherited ;
  fPinType := pntIO ;
  Size := 1 ;
  fFlags := [ vfDesignator, vfName, vfBody ] ;
end ;

destructor TMedaPin.Destroy ;
begin
  if assigned( fPort ) then
    fPort.fPin := nil ;
  fPort := nil ;
  inherited ;
end ;

function TMedaPin.GetColor : TGPColor ;
begin
  Result := aclMedaPin ;
end ;

function TMedaPin.GetIcon : TIconType ;
begin
  Result := iconPin ;
end ;

function TMedaPin.GetSize : integer ;
begin
  Result := fSize div cSchGrid ;
end ;

function TMedaPin.GetText( aColumn : integer ) : string ;
begin
  Result := '' ;
  case aColumn of
    0 : Result := 'Pin' ;
    1 : if assigned( Port ) then
        Result := Port.Designator
      else
        Result := fDesignator ;
    2 : Result := Format( '%g:%g', [ Offset.X, Offset.Y ] ) ;
    3 : if assigned( Port ) then
        Result := Port.Name
      else
        Result := Name ;
    4 : if assigned( Port ) then
        Result := Port.Designator
      else
        Result := Designator ;
  end ;
end ;

function TMedaPin.CheckType : TCheckType ;
begin
  Result := ctTristateCheckbox ;
end ;

procedure TMedaPin.SetDirection( const Value : TMedaDir ) ;
begin
  fDirection := Value ;
  Invalidate ;
end ;

procedure TMedaPin.SetOffset( const Value : TGPPointF ) ;
begin
  fOffset := Value ;
  Invalidate ;
end ;

procedure TMedaPin.BuildPath ;
begin
  inherited ;
  fPath.AddLine( 0, 0, fSize, 0 ) ;
  case fPinType of
    pntNone : begin
        fPath.Reset ;
        fPath.AddLine( fSize / 2, 0, fSize, 0 ) ;
      end ;
    pntIO, pntIn, pntOut : begin
        fPath.StartFigure ;
        fPath.AddRectangle( MakeRect( -cSchGrid / 8, -cSchGrid / 8, cSchGrid / 4, cSchGrid / 4 ) ) ;
        fPath.CloseFigure ;
      end ;
    pntIOInv, pntInInv, pntOutInv : begin
        fPath.StartFigure ;
        fPath.AddArc( 0, -cSchGrid / 4, cSchGrid / 2, cSchGrid / 2, 0, 360 ) ;
        fPath.CloseFigure ;
      end ;
    pntClock : begin
        fPath.StartFigure ;
        fPath.AddLine( 0, -cSchGrid / 4, -cSchGrid / 4, 0 ) ;
        fPath.AddLine( -cSchGrid / 4, 0, 0, cSchGrid / 4 ) ;
        fPath.CloseFigure ;
      end ;
    pntClockInv : begin
        fPath.StartFigure ;
        fPath.AddArc( 0, -cSchGrid / 4, cSchGrid / 2, cSchGrid / 2, 0, 360 ) ;
        fPath.AddLine( 0, -cSchGrid / 4, -cSchGrid / 4, 0 ) ;
        fPath.AddLine( -cSchGrid / 4, 0, 0, cSchGrid / 4 ) ;
        fPath.CloseFigure ;
      end ;
    pntPower : begin
        fPath.StartFigure ;
        fPath.AddLine( -cSchGrid / 8, -cSchGrid / 4, cSchGrid / 4, 0 ) ;
        fPath.AddLine( cSchGrid / 4, 0, -cSchGrid / 8, cSchGrid / 4 ) ;
        fPath.CloseFigure ;
      end ;
    pntGround : begin
        fPath.StartFigure ;
        fPath.AddLine( -cSchGrid / 8, -cSchGrid / 4, cSchGrid / 4, 0 ) ;
        fPath.AddLine( cSchGrid / 4, 0, -cSchGrid / 8, cSchGrid / 4 ) ;
        fPath.CloseFigure ;
      end ;
    pntAnalog : begin
        fPath.StartFigure ;
        fPath.AddArc( 0, -cSchGrid / 4, cSchGrid / 2, cSchGrid / 2, 0, 180 ) ;
        fPath.CloseFigure ;
      end ;
    pntPassive : begin
      end ;
    pntPortIn : begin
        fPath.StartFigure ;
        fPath.AddLine( -cSchGrid / 8, -cSchGrid / 4, cSchGrid / 4, 0 ) ;
        fPath.AddLine( cSchGrid / 4, 0, -cSchGrid / 8, cSchGrid / 4 ) ;
        fPath.CloseFigure ;
      end ;
    pntPortOut : begin
        fPath.StartFigure ;
        fPath.AddLine( cSchGrid / 8, -cSchGrid / 4, -cSchGrid / 4, 0 ) ;
        fPath.AddLine( -cSchGrid / 4, 0, cSchGrid / 8, cSchGrid / 4 ) ;
        fPath.CloseFigure ;
      end ;
    pntPortBidir : begin
        fPath.StartFigure ;
        fPath.AddLine( -cSchGrid / 8, -cSchGrid / 4, cSchGrid / 4, 0 ) ;
        fPath.AddLine( cSchGrid / 4, 0, -cSchGrid / 8, cSchGrid / 4 ) ;
        fPath.AddLine( cSchGrid / 8, -cSchGrid / 4, -cSchGrid / 4, 0 ) ;
        fPath.AddLine( -cSchGrid / 4, 0, cSchGrid / 8, cSchGrid / 4 ) ;
        fPath.CloseFigure ;
      end ;
  end ;
  fPath.SetMarker ;
end ;

procedure TMedaPin.SetSize( const Value : integer ) ;
begin
  fSize := Value * cSchGrid ;
  BuildPath ;
  Invalidate ;
end ;

procedure TMedaPin.Vaporize ;
begin
  if assigned( fPort ) then
    fPort.Pin := nil ;
  fPort := nil ;
  inherited ;
end ;

procedure TMedaPin.SetPinType( const Value : TMedaPortType ) ;
begin
  fPinType := Value ;
  BuildPath ;
  Invalidate ;
end ;

function TMedaPin.GetOutline : TGPRectF ;
var
  r                 : TGPRectF ;
begin
  r := inherited GetOutline ;
  GPInflateRect( r, cSchGrid / 4 ) ;
  Result := r ;
  case fDirection of
    drEast : ;
    drNorth : begin
        Result.X := r.Y ;
        Result.Y := -r.X + -r.Width ;
        Result.Width := r.Height ;
        Result.Height := r.Width ;
      end ;
    drWest : begin
        Result.X := -r.X - r.Width ;
        Result.Y := -r.Y - r.Height ;
      end ;
    drSouth : begin
        Result.X := -r.Y - r.Height ;
        Result.Y := r.X ;
        Result.Width := r.Height ;
        Result.Height := r.Width ;
      end ;
  end ;
  Result.X := Result.X + fOffset.X ;
  Result.Y := Result.Y + fOffset.Y ;
end ;

function TMedaPin.GetConnector( aPos : TGPPointF ) : TGPPointF ;
var
  p                 : TGPPointF ;
begin
  Result := MakePoint( 0.0, 0.0 ) ;
  case fDirection of
    drNorth : Result.Y := Result.Y - fSize ;
    drEast : Result.X := Result.X + fSize ;
    drSouth : Result.Y := Result.Y + fSize ;
    drWest : Result.X := Result.X - fSize ;
  end ;
  Result.X := Result.X + fOffset.X ;
  Result.Y := Result.Y + fOffset.Y ;

  p := Result ;
  case TMedaDir( Rotation div 45 ) of
    drEast : ;
    drNorth : begin
        Result.X := p.Y ;
        Result.Y := -p.X ;
      end ;
    drWest : begin
        Result.X := -p.X ;
        Result.Y := -p.Y ;
      end ;
    drSouth : begin
        Result.X := -p.Y ;
        Result.Y := p.X ;
      end ;
  end ;
  if Mirror then
    Result.X := -Result.X ;
  Result.X := Result.X + Position.X ;
  Result.Y := Result.Y + Position.Y ;
end ;

function TMedaPin.GetDesignator : string ;
begin
  if assigned( fPort ) then
    Result := fPort.Designator
  else
    Result := inherited GetDesignator ;
end ;

function TMedaPin.GetLink : TMedaObject ;
begin
  Result := nil ;
  if assigned( fPort ) then
    Result := fPort.Stack ;
end ;

function TMedaPin.GetName : string ;
begin
  if assigned( fPort ) then
    Result := fPort.Name
  else
    Result := inherited GetName ;
end ;

procedure TMedaPin.SetPort( const Value : TMedaPort ) ;
begin
  fPort := Value ;
  Invalidate ;
end ;

procedure TMedaPin.SetPortRef( const Value : TGUID ) ;
begin
  fPortRef := Value ;
end ;

procedure TMedaPin.SetPortRefAsString( const Value : string ) ;
begin
  if Pos( '{', Value ) > 0 then
    fPortRef := StringToGUID( Value ) ;
end ;

{ TMedaPad }

function TMedaPad.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

procedure TMedaPad.Assign( aObject : TMedaObject ) ;
begin
  inherited ;
  PadType := TMedaPad( aObject ).PadType ;
  Size := TMedaPad( aObject ).Size ;
end ;

function TMedaPad.CheckType : TCheckType ;
begin
  Result := ctCheckbox ;
end ;

function TMedaPad.Clone : TMedaObject ;
begin
  Result := TMedaPad.Create ;
end ;

procedure TMedaPad.SetPadType( const Value : TMedaPadType ) ;
begin
  fType := Value ;
end ;

procedure TMedaPad.SetSize( const Value : TGPSizeF ) ;
begin
  fSize := Value ;
  Rebuild ;
end ;

procedure TMedaPad.Rebuild ;
var
  s, c, r1, r2      : single ;
  iPoints           : array[ 0..7 ] of TGPPointF ;
  pPoints           : PGPPointF ;
  i, j              : integer ;
begin
  fPath.Reset ;
  case PadType of
    ptyCircle :
      fPath.AddEllipse( MakeRect( -Size.Width / 2, -Size.Height / 2, Size.Width, Size.Height ) ) ;
    ptyOcta : begin                     // build octagon
        s := Size.Height * sin( 22.5 ) ;
        c := Size.Height * cos( 22.5 ) ;
        iPoints[ 0 ] := MakePoint( +s, +c ) ;
        iPoints[ 1 ] := MakePoint( -s, +c ) ;
        iPoints[ 2 ] := MakePoint( -c, +s ) ;
        iPoints[ 3 ] := MakePoint( -c, -s ) ;
        iPoints[ 4 ] := MakePoint( -s, -c ) ;
        iPoints[ 5 ] := MakePoint( +s, -c ) ;
        iPoints[ 6 ] := MakePoint( +c, -s ) ;
        iPoints[ 7 ] := MakePoint( +c, +s ) ;
        pPoints := @iPoints ;
        fPath.StartFigure ;
        fPath.AddPolygon( pPoints, length( iPoints ) ) ;
      end ;
    ptyOblong :
      AddRoundRect( -Size.Width / 2, -Size.Height / 2, Size.Width / 2, Size.Height / 2, minF( Size.Width / 2, Size.Height / 2 ) ) ;
    ptyFinger :
      AddSemiRoundRect( -Size.Width / 2, -Size.Height / 2, Size.Width / 2, Size.Height / 2, minF( Size.Width / 2, Size.Height / 2 ) ) ;
    ptyRect :
      AddRectangle( -Size.Width / 2, -Size.Height / 2, Size.Width / 2, Size.Height / 2 ) ;
    ptyThermal : begin
        r1 := Size.Width / 2 ;
        r2 := r1 - Size.Height ;
        for i := 0 to 3 do begin
          fPath.StartFigure ;
          fPath.AddArc( -r1, -r1, 2 * r1, 2 * r1, i * 90 + 5, 80 ) ;
          fPath.AddArc( -r2, -r2, 2 * r2, 2 * r2, i * 90 + 85, -80 ) ;
          fPath.CloseFigure ;
        end ;
      end ;
    ptyFiducial : begin
        r1 := Size.Width / 2 ;
        r2 := r1 - Size.Height ;
        fPath.StartFigure ;
        fPath.AddArc( -r1, -r1, 2 * r1, 2 * r1, 0, 90 ) ;
        fPath.AddArc( -r2, -r2, 2 * r2, 2 * r2, 90, -90 ) ;
        fPath.CloseFigure ;
        fPath.StartFigure ;
        fPath.AddArc( -r1, -r1, 2 * r1, 2 * r1, 180, 90 ) ;
        fPath.AddArc( -r2, -r2, 2 * r2, 2 * r2, 270, -90 ) ;
        fPath.CloseFigure ;
      end ;
    ptyMoire : begin
        r1 := Size.Width / 2 ;
        for j := 0 to 31 do begin
          r2 := r1 - Size.Height ;
          if r2 < 0.0 then
            Break ;
          for i := 0 to 1 do begin
            fPath.StartFigure ;
            fPath.AddArc( -r1, -r1, 2 * r1, 2 * r1, i * 180 + j * 90, 90 ) ;
            fPath.AddArc( -r2, -r2, 2 * r2, 2 * r2, i * 180 + j * 90 + 90, -90 ) ;
            fPath.CloseFigure ;
          end ;
          r1 := r2 ;
        end ;
      end ;
  end ;
  fPath.SetMarker ;
  Invalidate ;
end ;

procedure TMedaPad.Build( aPadType : TMedaPadType ; aSize : TGPSizeF ) ;
begin
  fType := aPadType ;
  Size := aSize ;
  Rebuild ;
end ;

procedure TMedaPad.Build( aPadType : TMedaPadType ; coor : array of double ) ;
begin
  fType := aPadType ;
  case fType of
    ptyCircle :
      Size := MakeSize( coor[ 0 ], coor[ 0 ] ) ;
    ptyOcta :
      Size := MakeSize( coor[ 0 ], coor[ 0 ] ) ;
    ptyOblong, ptyRect :
      Size := MakeSize( coor[ 0 ], coor[ 1 ] ) ;
  end ;
  Rebuild ;
end ;

function TMedaPad.GetConnector( aPoint : TGPPointF ) : TGPPointF ;
var
  dA, dB, dC        : double ;
  iStack            : TMedaStack ;
begin
  iStack := fParent as TMedaStack ;
  Result.X := Position.X + iStack.Offset.X ;
  Result.Y := Position.Y + iStack.Offset.Y ;
  case fType of
    ptyRect, ptyOblong : begin
        // a line shaped Pad has 3 connection points: middle and two ends.
        aPoint.X := aPoint.X - Result.X ;
        aPoint.Y := aPoint.Y - Result.Y ;
        dC := sqr( aPoint.X ) + sqr( aPoint.Y ) ;
        if Size.Width < Size.Height then begin
          dA := sqr( aPoint.X ) + sqr( aPoint.Y + Size.Height / 2 ) ;
          dB := sqr( aPoint.X ) + sqr( aPoint.Y - Size.Height / 2 ) ;
          // find the closest
          if ( dC < dA ) and ( dC < dB ) then
          else if dA < dB then
            Result.Y := Round( Result.Y - Size.Height / 2 + Size.Width / 2 )
          else
            Result.Y := Round( Result.Y + Size.Height / 2 - Size.Width / 2 ) ;
        end
        else begin
          dA := sqr( aPoint.X + Size.Width / 2 ) + sqr( aPoint.Y ) ;
          dB := sqr( aPoint.X - Size.Width / 2 ) + sqr( aPoint.Y ) ;
          // find the closest
          if ( dC < dA ) and ( dC < dB ) then
          else if dA < dB then
            Result.X := Round( Result.X - Size.Width / 2 + Size.Height / 2 )
          else
            Result.X := Round( Result.X + Size.Width / 2 - Size.Height / 2 ) ;
        end ;
      end ;
  end ;
end ;

function TMedaPad.GetOutline : TGPRectF ;
var
  iStack            : TMedaStack ;
begin
  Result := inherited GetOutline ;
  iStack := fParent as TMedaStack ;
  Assert( assigned( iStack ) ) ;
  Result.X := Result.X + iStack.Offset.X ;
  Result.Y := Result.Y + iStack.Offset.Y ;
end ;

procedure TMedaPad.SetSelection( aFlag : TMedaState ) ;
begin
  inherited ;
  if fParent.GetSelection <> aFlag then
    fParent.SetSelection( aFlag ) ;
end ;

function TMedaPad.GetText( aColumn : integer ) : string ;
begin
  Result := inherited GetText( aColumn ) ;
  case aColumn of
    0 : Result := 'Pad' ;
    2 : if Placed then
        Result := GetPCBLayerName( fLayerType ) ;
  end ;
end ;

procedure TMedaPad.PlaceMe ;
begin
  inherited ;
  if assigned( fView ) then
    fLayerType := TMedaLayer( TMedaView( fView ).Viewer ).Layertype ;
end ;

constructor TMedaPad.Create ;
begin
  inherited ;
  Name := 'Pad' ;
end ;

function TMedaPad.GetIcon : TIconType ;
begin
  Result := iconPad ;
end ;

function TMedaPad.GetLink : TMedaObject ;
begin
  Result := fParent ;
  if assigned( Result ) then
    Result := ( fParent as TMedaStack ).Port ;
  if assigned( Result ) then
    Result := ( Result as TMedaPort ).Pin ;
end ;

{ TMedaStack }

function TMedaStack.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

procedure TMedaStack.Assign( aObject : TMedaObject ) ;
var
  i                 : integer ;
  iPad, iClone      : TMedaPad ;
begin
  inherited ;
  if assigned( aObject ) then begin
    Assert( aObject is TMedaStack ) ;
    Name := aObject.Name ;
    fDesignator := aObject.fDesignator ;
    fObjects.Clear ;
    for i := 0 to TMedaStack( aObject ).fObjects.Count - 1 do begin
      iPad := TMedaStack( aObject ).fObjects[ i ] as TMedaPad ;
      iClone := iPad.Clone as TMedaPad ;
      iClone.Assign( iPad ) ;
      iClone.Parent := Self ;
      iClone.Module := fModule ;
      fObjects.Add( iClone ) ;
    end ;
    fOffset := TMedaStack( aObject ).fOffset ;
  end ;
end ;

constructor TMedaStack.Create ;
begin
  inherited ;
  fFlags := [ vfBody ] ;
end ;

destructor TMedaStack.Destroy ;
begin
  if assigned( fPort ) then
    fPort.fStack := nil ;
  fPort := nil ;
  inherited ;
end ;

function TMedaStack.GetIcon : TIconType ;
begin
  Result := iconStack ;
end ;

procedure TMedaStack.SetOffset( const Value : TGPPointF ) ;
begin
  fOffset := Value ;
  Invalidate ;
end ;

function TMedaStack.CheckType : TCheckType ;
begin
  Result := ctTristateCheckbox ;
end ;

function TMedaStack.GetText( aColumn : integer ) : string ;
begin
  Result := '' ;
  case aColumn of
    0 : Result := 'Stack' ;
    1 : if assigned( fPort ) then
        Result := fPort.GetDesignator
      else
        Result := fDesignator ;
    2 : Result := Format( '%.5g:%.5g', [ Position.X + fOffset.X, Position.Y + fOffset.X ] ) ;
  end ;
end ;

procedure TMedaStack.LinkPort ;
var
  iShape            : TMedaShape ;
  iPart             : TMedaPart ;
  iPort             : TMedaPort ;
begin
  iShape := Parent as TMedaShape ;
  iPart := iShape.Parent as TMedaPart ;
  Assert( assigned( iPart ) ) ;
  iPort := iPart.PortByGUID( PortRef ) ;
  Assert( assigned( iPort ) ) ;
  iPort.Stack := Self ;
end ;

procedure TMedaStack.LoadPad( aFilename : string ) ;
begin
end ;

function TMedaStack.GetColor : TGPColor ;
begin
  Result := aclMedaStack ;
end ;

function TMedaStack.GetLink : TMedaObject ;
begin
  Result := nil ;
  if assigned( fPort ) then
    Result := fPort.Pin ;
end ;

procedure TMedaStack.SetPort( const Value : TMedaPort ) ;
begin
  fPort := Value ;
  Invalidate ;
end ;

procedure TMedaStack.SetPortRef( const Value : TGUID ) ;
begin
  FPortRef := Value ;
end ;

procedure TMedaStack.SetPortRefAsString( const Value : string ) ;
begin
  if Pos( '{', Value ) > 0 then
    fPortRef := StringToGUID( Value ) ;
end ;

procedure TMedaStack.SetHole( const Value : single ) ;
begin
  fHole := Value ;
  Invalidate ;
end ;

function TMedaStack.GetPad( Index : integer ) : TMedaPad ;
begin
  Result := fObjects[ Index ] as TMedaPad ;
end ;

function TMedaStack.AddPad : TMedaPad ;
begin
  fObjects.Add( TMedaPad.Create ) ;
  Result := fObjects.Last as TMedaPad ;
  Result.Name := 'Pad' ;
  Result.Designator := GetNewDesignator( '_y' ) ;
  Result.Module := fModule ;
  Result.Parent := Self ;
  Result.PlaceRef := PlaceRef ;
  Result.Transforms[ 0 ] := Transforms[ 0 ] ;
  Result.Size := MakeSize( 100.0, 50.0 ) ;
end ;

procedure TMedaStack.SetPad( Index : integer ; const Value : TMedaPad ) ;
begin
  fObjects[ Index ] := Value ;
end ;

function TMedaStack.Clone : TMedaObject ;
begin
  Result := TMedaStack.Create ;
end ;

procedure TMedaStack.SetSelection( aFlag : TMedaState ) ;
var
  i                 : integer ;
begin
  inherited ;
  for i := 0 to Count - 1 do
    Pad[ i ].SetSelection( aFlag ) ;
end ;

function TMedaStack.Show : TPoint ;
begin
  if Count > 0 then
    Pad[ 0 ].Show ;
end ;

procedure TMedaStack.Vaporize ;
begin
  inherited ;
  if assigned( fPort ) then
    fPort.Stack := nil ;
end ;

{ TMedaVia }

function TMedaVia.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

constructor TMedaVia.Create ;
begin
  inherited ;
  Name := 'Via' ;
end ;

function TMedaVia.GetColor : TGPColor ;
begin
  Result := aclMedaVia ;
end ;

function TMedaVia.GetIcon : TIconType ;
begin
  Result := iconVia ;
end ;

function TMedaVia.GetLink : TMedaObject ;
begin
  Result := nil ;
end ;

function TMedaVia.GetText( aColumn : integer ) : string ;
begin
  Result := '' ;
  case aColumn of
    0 : Result := 'Via' ;
    1 : if assigned( fParent ) then
        Result := fParent.GetName ;
    2 : Result := Format( '%.5g:%.5g', [ Position.X + fOffset.X, Position.Y + fOffset.X ] ) ;
  end ;
end ;

{ TMedaBlind }

function TMedaBlind.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

function TMedaBlind.GetColor : TGPColor ;
begin
  Result := aclMedaBlind ;
end ;

function TMedaBlind.GetIcon : TIconType ;
begin
  Result := iconVia ;
end ;

function TMedaBlind.GetLink : TMedaObject ;
begin
  Result := nil ;
end ;

{ TMedaBuried }

function TMedaBuried.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

function TMedaBuried.GetColor : TGPColor ;
begin
  Result := aclMedaBuried ;
end ;

function TMedaBuried.GetIcon : TIconType ;
begin
  Result := iconVia ;
end ;

function TMedaBuried.GetLink : TMedaObject ;
begin
  Result := nil ;
end ;

{ TMedaFiducial }

function TMedaFiducial.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMedaWire }

function TMedaWire.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

function TMedaWire.GetIcon : TIconType ;
begin
  Result := iconLine ;
end ;

function TMedaWire.GetNet : TMedaNet ;
var
  fObject           : TMedaObject ;
begin
  fObject := fParent ;
  while assigned( fObject ) and not ( fObject is TMedaNet ) do
    fObject := fObject.fParent ;
  Result := TMedaNet( fObject ) ;
end ;

function TMedaWire.GetOutline : TGPRectF ;
begin
  Result := inherited GetOutline ;
  GPInflateRect( Result, cSchGrid / 2 ) ;
end ;

function TMedaWire.CheckType : TCheckType ;
begin
  Result := ctTristateCheckbox ;
end ;

function TMedaWire.GetColor : TGPColor ;
begin
  Result := aclMedaLine ;
end ;

procedure TMedaWire.AddDot( aPoint : TGPPointF ) ;
begin
  AddEllipse( aPoint.X - 4, aPoint.Y - 4, aPoint.X + 4, aPoint.Y + 4 ) ;
end ;

procedure TMedaWire.AddStroke( aPoint1, aPoint2 : TGPPointF ) ;
begin
  AddLine( aPoint1.X, aPoint1.Y, aPoint2.X, aPoint2.Y ) ;
end ;

function TMedaWire.GetConnector( aPos : TGPPointF ) : TGPPointF ;
var
  i, n              : integer ;
  p1, p2            : TGPPointF ;
  iTypes            : array of Byte ;
  iPoints           : array of TGPPointF ;
  iIterator         : TGPGraphicsPathIterator ;
begin
  Result := Position ;
  if fPath.GetPointCount <= 1 then
    Exit ;

  iIterator := TGPGraphicsPathIterator.Create( fPath ) ;
  try
    n := iIterator.GetCount ;
    Setlength( iPoints, n ) ;
    Setlength( iTypes, n ) ;
    iIterator.Enumerate( PGPPointF( @iPoints[ 0 ] ), PByte( @iTypes[ 0 ] ), n ) ;
    for i := 0 to n - 1 do begin
      p1 := iPoints[ i ] ;
      GPOffsetPoint( p1, Position ) ;
      if Distance( p1, aPos ) < cSchGrid then begin
        Result := p1 ;
        Exit ;
      end ;
    end ;
    for i := 0 to n - 2 do begin
      p1 := iPoints[ i ] ;
      GPOffsetPoint( p1, Position ) ;
      p2 := iPoints[ i + 1 ] ;
      GPOffsetPoint( p2, Position ) ;
      if Distance( p1, aPos ) + Distance( p2, aPos ) - Distance( p1, p2 ) <
        cSchGrid then begin
        if abs( p1.X - p2.X ) < abs( p1.Y - p2.Y ) then begin
          // mainly horizontal line
          Result.X := aPos.X ;
          Result.Y := aPos.Y ;
        end
        else begin
          // mainly vertical line
          Result.X := aPos.X ;
          Result.Y := aPos.Y ;
        end ;
        Exit ;
      end ;
    end ;
  finally
    iTypes := nil ;
    iPoints := nil ;
    iIterator.Free ;
  end ;
end ;

function TMedaWire.GetPoints( var aPoint1, aPoint2 : TGPPointF ) : boolean ;
var
  n                 : integer ;
  iTypes            : array of Byte ;
  iPoints           : array of TGPPointF ;
  iIterator         : TGPGraphicsPathIterator ;
begin
  Result := False ;
  iIterator := TGPGraphicsPathIterator.Create( fPath ) ;
  try
    n := iIterator.GetCount ;
    if n <= 0 then
      Exit ;
    Setlength( iPoints, n ) ;
    Setlength( iTypes, n ) ;
    iIterator.Enumerate( PGPPointF( @iPoints[ 0 ] ), PByte( @iTypes[ 0 ] ), n ) ;
    aPoint1 := iPoints[ 0 ] ;
    GPOffsetPoint( aPoint1, Position ) ;
    aPoint2 := iPoints[ 1 ] ;
    GPOffsetPoint( aPoint2, Position ) ;
    Result := True ;
  finally
    iTypes := nil ;
    iPoints := nil ;
    iIterator.Free ;
  end ;
end ;

procedure TMedaWire.MovePoint( aFrom, aTo : TGPPointF ) ;
var
  p1, p2            : TGPPointF ;
begin
  GetPoints( p1, p2 ) ;
  //  if IsEqualPoint( aFrom, p1 ) then
  Invalidate ;
end ;

procedure TMedaWire.SetPoints( const aPoint1, aPoint2 : TGPPointF ) ;
var
  p                 : TGPPointF ;
begin
  fTransforms[ 0 ].Position := aPoint1 ;
  p := aPoint2 ;
  p.X := p.X - aPoint1.X ;
  p.Y := p.Y - aPoint1.Y ;
  fPath.Reset ;
  AddLine( 0, 0, p.X, p.Y ) ;
  Invalidate ;
end ;

function TMedaWire.GetLink : TMedaObject ;
begin
  Result := nil ;
end ;

{ TMedaLabel }

function TMedaLabel.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

function TMedaLabel.GetColor : TGPColor ;
begin
  Result := aclMedaLabel ;
end ;

function TMedaLabel.GetLink : TMedaObject ;
begin
  Result := nil ;
end ;

function TMedaLabel.GetText( aColumn : integer ) : string ;
begin
  Result := '' ;
  case aColumn of
    0 : if assigned( Parent ) then
        Result := Parent.Name
      else
        Result := Name ;
    1 : Result := Designator ;
    2 : Result := Format( '%g:%g', [ Position.X, Position.Y ] ) ;
  end ;
end ;

procedure TMedaLabel.PlaceMe ;
begin
  BuildPath ;
  inherited ;
end ;

function TMedaLabel.CheckType : TCheckType ;
begin
  Result := ctCheckbox ;
end ;

procedure TMedaLabel.BuildPath ;
const
  HSize             : single = 2 ;
  VSize             : single = 1 ;
begin
  fPath.Reset ;
  if assigned( fParent ) then begin
    case ( fParent as TMedaNet ).PortType of
      pntPortIn :
        AddSemiRoundRect( 0, -cSchGrid * VSize / 3, cSchGrid * HSize, cSchGrid * VSize / 3, cSchGrid / 6 ) ;
      pntPortOut :
        AddSemiRoundRect2( 0, -cSchGrid * VSize / 3, cSchGrid * HSize, cSchGrid * VSize / 3, cSchGrid / 6 ) ;
      pntPortBiDir :
        AddRoundRect( 0, -cSchGrid * VSize / 3, cSchGrid * HSize, cSchGrid * VSize / 3, cSchGrid / 6 ) ;
    else
      AddRectangle( 0, -cSchGrid * VSize / 3, cSchGrid * HSize, cSchGrid * VSize / 3 ) ;
    end ;
  end ;
end ;

{ TMedaPower }

function TMedaPower.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

procedure TMedaPower.BuildPath ;
begin
  fPath.Reset ;
  fPath.StartFigure ;
  case fPowerType of
    pwtBar : begin
        fPath.AddRectangle( MakeRect( -cSchGrid / 2, 3 * cSchGrid / 4, cSchGrid, cSchGrid / 4 ) ) ;
        fPath.StartFigure ;
        fPath.AddLine( 0, 0, 0, 3 * cSchGrid / 4 ) ;
      end ;
    pwtGround : begin
        fPath.AddLine( -cSchGrid / 2, cSchGrid / 2, cSchGrid / 2, cSchGrid / 2 ) ;
        fPath.StartFigure ;
        fPath.AddLine( -cSchGrid / 2, cSchGrid / 2, -cSchGrid / 2 - cSchGrid / 8, cSchGrid ) ;
        fPath.StartFigure ;
        fPath.AddLine( -cSchGrid / 2 + cSchGrid / 2, cSchGrid / 2, -cSchGrid / 2 - cSchGrid / 8 + cSchGrid / 2, cSchGrid ) ;
        fPath.StartFigure ;
        fPath.AddLine( -cSchGrid / 2 + cSchGrid, cSchGrid / 2, -cSchGrid / 2 - cSchGrid / 8 + cSchGrid, cSchGrid ) ;
        fPath.StartFigure ;
        fPath.AddLine( 0, 0, 0, cSchGrid / 2 ) ;
      end ;
    pwtEarth : begin
        fPath.AddLine( -cSchGrid / 2, cSchGrid / 2, cSchGrid / 2, cSchGrid / 2 ) ;
        fPath.StartFigure ;
        fPath.AddLine( -cSchGrid / 2 + cSchGrid / 8, cSchGrid / 2 + cSchGrid / 8, cSchGrid / 2 - cSchGrid / 8, cSchGrid / 2 + cSchGrid / 8 ) ;
        fPath.StartFigure ;
        fPath.AddLine( -cSchGrid / 2 + cSchGrid / 4, cSchGrid / 2 + cSchGrid / 4, cSchGrid / 2 - cSchGrid / 4, cSchGrid / 2 + cSchGrid / 4 ) ;
        fPath.StartFigure ;
        fPath.AddLine( -cSchGrid / 2 + 3 * cSchGrid / 8, cSchGrid / 2 + 3 * cSchGrid / 8, cSchGrid / 2 - 3 * cSchGrid / 8, cSchGrid / 2 + 3 * cSchGrid / 8 ) ;
        fPath.StartFigure ;
        fPath.AddLine( 0, 0, 0, cSchGrid / 2 ) ;
      end ;
    pwtCircle : begin
        fPath.AddEllipse( MakeRect( -cSchGrid / 4, cSchGrid / 2, cSchGrid / 2, cSchGrid / 2 ) ) ;
        fPath.StartFigure ;
        fPath.AddLine( 0, 0, 0, cSchGrid / 2 ) ;
      end ;
    pwtArrow : begin
        fPath.AddPie( MakeRect( -cSchGrid / 2, cSchGrid / 2, cSchGrid, cSchGrid ), 240, 60 ) ;
        fPath.StartFigure ;
        fPath.AddLine( 0, 0, 0, cSchGrid / 2 ) ;
      end ;
  else
    fPath.AddRectangle( MakeRect( -cSchGrid / 2, 3 * cSchGrid / 4, cSchGrid, cSchGrid / 4 ) ) ;
    fPath.StartFigure ;
    fPath.AddLine( 0, 0, 0, 3 * cSchGrid / 4 ) ;
  end ;
  fPath.SetMarker ;
  Invalidate ;
end ;

function TMedaPower.GetColor : TGPColor ;
begin
  Result := aclMedaLabel ;
end ;

function TMedaPower.GetLink : TMedaObject ;
begin
  Result := nil ;
end ;

function TMedaPower.GetPowerType : TMedaPowerType ;
begin
  Result := fPowerType ;
end ;

procedure TMedaPower.SetPowerType( const Value : TMedaPowerType ) ;
begin
  fPowerType := Value ;
  BuildPath ;
  Invalidate ;
end ;

{ TMedaTrack }

function TMedaTrack.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

function TMedaTrack.GetColor : TGPColor ;
begin
  Result := aclMedaTrack ;
end ;

function TMedaTrack.GetIcon : TIconType ;
begin
  Result := iconTrack ;
end ;

function TMedaTrack.GetLink : TMedaObject ;
begin
  Result := nil ;
end ;

function TMedaTrack.GetOutline : TGPRectF ;
begin
  Result := inherited GetOutline ;
  GPInflateRect( Result, fWidth / 2 ) ;
end ;

function TMedaTrack.IsPCBPhysical : boolean ;
begin
  Result := True ;
end ;

procedure TMedaTrack.PlaceMe ;
begin
  inherited ;
  if assigned( fView ) then
    fLayerType := TMedaLayer( TMedaView( fView ).Viewer ).LayerType ;
end ;

procedure TMedaTrack.SetWidth( const Value : single ) ;
begin
  fWidth := Value ;
  Invalidate ;
end ;

{ TMedaCopper }

function TMedaCopper.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

function TMedaCopper.GetColor : TGPColor ;
begin
  Result := aclMedaTrack ;
end ;

function TMedaCopper.GetIcon : TIconType ;
begin
  Result := iconCopper ;
end ;

procedure TMedaCopper.AddPolygon( aPoints : array of TGPPointF ) ;
begin
  inherited AddPolygon( aPoints ) ;
end ;

function TMedaCopper.CheckType : TCheckType ;
begin
  Result := ctCheckbox ;
end ;

{ TMedaGroup }

function TMedaGroup.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMedaNetBundle }

function TMedaNetBundle.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMedaPinBundle }

function TMedaPinBundle.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMedaNetBus }

function TMedaNetBus.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMedaPinBus }

function TMedaPinBus.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMedaContainer }

constructor TMedaContainer.Create ;
begin
  inherited ;
  fObjects := TObjectlist.Create( False ) ;
end ;

destructor TMedaContainer.Destroy ;
begin
  fObjects.Free ;
  inherited ;
end ;

function TMedaContainer.GetObjectCount : integer ;
begin
  Result := fObjects.Count ;
end ;

function TMedaContainer.GetObjects( index : integer ) : TMedaObject ;
begin
  Result := nil ;
  if index < fObjects.Count then
    Result := TMedaObject( fObjects[ index ] ) ;
end ;

procedure TMedaContainer.SetObjects( index : integer ; const Value : TMedaObject ) ;
begin
  if index < fObjects.Count then
    fObjects[ index ] := Value ;
end ;

procedure TMedaContainer.Add( var aObject : TMedaObject ) ;
begin
  if assigned( aObject ) then begin
    fObjects.Add( aObject ) ;
    Update ;
  end ;
end ;

function TMedaContainer.GetChildCount : integer ;
begin
  Result := fObjects.Count ;
end ;

function TMedaContainer.GetCount : integer ;
begin
  Result := fObjects.Count ;
end ;

function TMedaContainer.GetChild( index : integer ) : TMedaViewable ;
begin
  Result := GetObjects( index ) ;
end ;

procedure TMedaContainer.Clear ;
begin
  fObjects.Clear ;
  Update ;
end ;

procedure TMedaContainer.SetTransform( index : integer ; const Value : TMedaTransform ) ;
var
  i                 : integer ;
begin
  inherited ;
  for i := 0 to fObjects.Count - 1 do
    if assigned( fObjects[ i ] ) then
      Objects[ i ].Transforms[ index ] := Value ;
end ;

procedure TMedaContainer.SetModule( const Value : TMedaModule ) ;
var
  i                 : integer ;
begin
  inherited ;
  for i := 0 to Count - 1 do
    if assigned( Objects[ i ] ) then
      Objects[ i ].SetModule( Value ) ;
end ;

procedure TMedaContainer.SetParent( const Value : TMedaContainer ) ;
var
  i                 : integer ;
begin
  inherited ;
  for i := 0 to Count - 1 do
    if assigned( Objects[ i ] ) then
      Objects[ i ].SetParent( Value ) ;
end ;

procedure TMedaContainer.SetPlaceRef( const Value : TGUID ) ;
var
  i                 : integer ;
begin
  inherited ;
  for i := 0 to Count - 1 do
    if assigned( Objects[ i ] ) then
      Objects[ i ].PlaceRef := Value ;
end ;

function TMedaContainer.FindNodeByGUID( hHandle : TGUID ) : TMedaObject ;
var
  i                 : integer ;
begin
  Result := inherited FindNodeByGUID( hHandle ) ;
  if assigned( Result ) then
    Exit ;
  for i := 0 to Count - 1 do
    if assigned( Objects[ i ] ) then begin
      Result := Objects[ i ].FindNodeByGUID( hHandle ) ;
      if assigned( Result ) then
        Exit ;
    end ;
  Result := nil ;
end ;

function TMedaContainer.GetColor : TGPColor ;
begin
  Result := aclMedaContainer ;
end ;

function TMedaContainer.GetText( aColumn : integer ) : string ;
begin
  Result := inherited GetText( aColumn ) ;
  if ( aColumn = 2 ) and ( GetCount > 0 ) then
    Result := Format( '%d', [ GetCount ] ) ;
end ;

procedure TMedaContainer.Invalidate ;
var
  i                 : integer ;
begin
  inherited ;
  for i := 0 to Count - 1 do
    if assigned( Objects[ i ] ) then
      Objects[ i ].Invalidate ;
end ;

function Compare( Item1, Item2 : Pointer ) : Integer ;
var
  a, b              : TMedaObject ;
begin
  a := TMedaObject( Item1 ) ;
  b := TMedaObject( Item2 ) ;
  if a.ClassName < b.ClassName then
    Result := -1
  else if a.ClassName > b.ClassName then
    Result := 1
  else if a.Name < b.Name then
    Result := -1
  else if a.Name > b.Name then
    Result := 1
  else
    Result := 0 ;
end ;

function CompareName( Item1, Item2 : Pointer ) : Integer ;
var
  a, b              : TMedaObject ;
begin
  Result := 0 ;
  if assigned( Item1 ) and assigned( Item2 ) then begin
    a := TMedaObject( Item1 ) ;
    b := TMedaObject( Item2 ) ;
    Result := AnsiCompareText( a.Name, b.Name ) ;
  end ;
end ;

function CompareRef( Item1, Item2 : Pointer ) : Integer ;
var
  a, b              : TMedaObject ;
begin
  a := TMedaObject( Item1 ) ;
  b := TMedaObject( Item2 ) ;
  Result := AnsiCompareText( a.fDesignator, b.fDesignator ) ;
end ;

procedure TMedaContainer.Sort ;
var
  i                 : integer ;
begin
  inherited Sort ;
  case Project.SortMode of
    0 : fObjects.Sort( CompareName ) ;
    1 : fObjects.Sort( CompareRef ) ;
  end ;
  for i := 0 to Count - 1 do
    if assigned( Objects[ i ] ) then
      Objects[ i ].Sort ;
end ;

procedure TMedaContainer.Rotate( aAngle : integer ) ;
var
  i                 : integer ;
begin
  inherited ;
  for i := 0 to Count - 1 do
    if assigned( Objects[ i ] ) then
      Objects[ i ].Rotate( aAngle ) ;
end ;

procedure TMedaContainer.Mark ;
var
  i                 : integer ;
begin
  inherited ;
  for i := 0 to ObjectCount - 1 do
    if assigned( Objects[ i ] ) then
      Objects[ i ].Mark ;
end ;

procedure TMedaContainer.Mirrorize ;
var
  i                 : integer ;
begin
  inherited ;
  for i := 0 to Count - 1 do
    if assigned( Objects[ i ] ) then
      Objects[ i ].Mirrorize ;
end ;

procedure TMedaContainer.PlaceMe ;
var
  i                 : integer ;
begin
  inherited ;
  for i := Count - 1 downto 0 do
    if assigned( Objects[ i ] ) then
      Objects[ i ].PlaceMe ;
end ;

procedure TMedaContainer.Unplace ;
var
  i                 : integer ;
begin
  for i := Count - 1 downto 0 do
    if assigned( Objects[ i ] ) then
      Objects[ i ].Unplace ;
  inherited ;
end ;

procedure TMedaContainer.Vaporize ;
var
  i                 : integer ;
begin
  for i := Count - 1 downto 0 do
    if assigned( Objects[ i ] ) then begin
      Objects[ i ].Parent := nil ;
      Objects[ i ].Vaporize ;
    end ;
  inherited ;
  Update ;
  Invalidate ;
end ;

procedure TMedaContainer.Delete( index : integer ) ;
begin
  if index < Count then
    Remove( Objects[ index ] ) ;
end ;

procedure TMedaContainer.Remove( aObject : TMedaObject ) ;
begin
  if assigned( aObject ) then begin
    aObject.Parent := nil ;
    fObjects.Remove( aObject ) ;
    aObject.Vaporize ;
    Update ;
  end ;
end ;

function TMedaContainer.Extract( aObject : TMedaObject ) : TMedaObject ;
begin
  Result := nil ;
  if assigned( aObject ) then begin
    aObject.Parent := nil ;
    Result := fObjects.Extract( aObject ) as TMedaObject ;
    Update ;
  end ;
end ;

procedure TMedaContainer.RemoveAll ;
var
  i                 : integer ;
begin
  for i := Count - 1 downto 0 do
    Delete( i ) ;
  Assert( fObjects.Count = 0 ) ;
  Update ;
end ;

function TMedaContainer.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

function TMedaContainer.Clone : TMedaObject ;
begin
  Result := TMedaContainer.Create ;
end ;

function TMedaContainer.GetIcon : TIconType ;
begin
  Result := iconContainer ;
end ;

{ TMedaObject }

function TMedaObject.CanEdit( aColumn : integer ) : boolean ;
begin
  Result := False ;
end ;

function TMedaObject.GetIcon : TIconType ;
begin
  Result := iconUnknown ;
end ;

function TMedaObject.GetText( aColumn : integer ) : string ;
begin
  Result := '' ;
  case aColumn of
    0 : Result := GetName ;
    1 : Result := fDesignator ;
  end ;
end ;

procedure TMedaObject.Invalidate ;
begin
  inherited ;
  if assigned( fView ) then
    TMedaView( fView ).Invalidate ;
end ;

function TMedaObject.GetChild( index : integer ) : TMedaViewable ;
begin
  Result := nil ;
end ;

constructor TMedaObject.Create ;
begin
  inherited ;
  fPath := TGPGraphicsPath.Create ;
  fFlags := [ vfBody, vfName, vfDesignator ] ;
end ;

destructor TMedaObject.Destroy ;
begin
  if Placed then
    Unplace ;
  if assigned( fPath ) then
    FreeAndNil( fPath ) ;
  inherited ;
end ;

procedure TMedaObject.SetSelection( aFlag : TMedaState ) ;
begin
  inherited ;
  if assigned( fView ) then
    fView.SetSelection( aFlag ) ;
  Invalidate ;
end ;

procedure TMedaObject.PlaceMe ;
begin
  fView := ViewFactory.Place( Self ) ;
  Invalidate ;
end ;

procedure TMedaObject.Unplace ;
begin
  Invalidate ;
  if assigned( fView ) then
    ViewFactory.Unplace( fView as TMedaView ) ;
end ;

function TMedaObject.Placed : boolean ;
begin
  Result := assigned( fView ) ;
end ;

procedure TMedaObject.SetModule( const Value : TMedaModule ) ;
begin
  fModule := Value ;
end ;

procedure TMedaObject.SetOutline( const Value : TGPRectF ) ;
begin
end ;

function TMedaObject.GetDesignator : string ;
begin
  Result := fDesignator ;
end ;

procedure TMedaObject.SetDesignator( const Value : string ) ;
begin
  fDesignator := Value ;
  Invalidate ;
end ;

function TMedaObject.GetColor : TGPColor ;
begin
  Result := aclMedaObject ;
end ;

procedure TMedaObject.Sort ;
begin
end ;

procedure TMedaObject.Assign( aObject : TMedaObject ) ;
begin
  if assigned( aObject ) then begin
    Name := aObject.Name ;
    Designator := aObject.Designator ;
    fFlags := aObject.Flags ;
    fTransforms := aObject.fTransforms ;
    Path := aObject.Path.Clone ;
  end ;
end ;

procedure TMedaObject.Build( aName : string ) ;
begin
  Name := aName ;
end ;

procedure TMedaObject.BuildOutline( const aOutline : array of double ) ;
var
  i                 : integer ;
  r                 : TGPRectF ;
begin
  r := MakeRect( 10E20, 10E20, -10E20, -10E20 ) ;
  for i := Low( aOutline ) div 2 to High( aOutline ) div 2 do begin
    if r.X > Round( aOutline[ 2 * i ] ) then
      r.X := Round( aOutline[ 2 * i ] ) ;
    if r.Y > Round( aOutline[ 2 * i + 1 ] ) then
      r.Y := Round( aOutline[ 2 * i + 1 ] ) ;
    if r.Width < Round( aOutline[ 2 * i ] ) then
      r.Width := Round( aOutline[ 2 * i ] ) ;
    if r.Height < Round( aOutline[ 2 * i + 1 ] ) then
      r.Height := Round( aOutline[ 2 * i + 1 ] ) ;
  end ;
  r.Width := r.Width - r.X ;
  r.Height := r.Height - r.Y ;
  Outline := r ;
end ;

procedure TMedaObject.BuildPath ;
begin
  fPath.Reset ;
end ;

procedure TMedaObject.SetPlaceRef( const Value : TGUID ) ;
begin
  fPlaceRef := Value ;
end ;

procedure TMedaObject.SetPlaceRefAsString( const Value : string ) ;
begin
  if Pos( '{', Value ) > 0 then
    fPlaceRef := StringToGUID( Value ) ;
end ;

procedure TMedaObject.SetPosition( const Value : TGPPointF ) ;
begin
  fTransforms[ 0 ].Position := Value ;
  Invalidate ;
end ;

procedure TMedaObject.SetParent( const Value : TMedaContainer ) ;
begin
  fParent := Value ;
end ;

function TMedaObject.Show : TPoint ;
begin
  Result := inherited Show ;
  if assigned( fView ) then
    Result := fView.Show ;
end ;

function TMedaObject.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

function TMedaObject.AcceptView( Visitor : TObject ) : TObject ;
begin
  Result := nil ;
  if assigned( fView ) then
    Result := fView.Accept( Visitor ) ;
end ;

function TMedaObject.IsPCBPhysical : boolean ;
begin
  Result := False ;
end ;

function TMedaObject.IsPlaced : boolean ;
begin
  Result := assigned( fView ) and fView.IsPlaced ;
end ;

function TMedaObject.IsSchemPhysical : boolean ;
begin
  Result := False ;
end ;

procedure TMedaObject.LinkPort ;
begin
end ;

procedure TMedaObject.Vaporize ;
begin
  if Placed then
    Unplace ;
  if assigned( fParent ) then
    fParent.Remove( Self ) ;
  Update ;
  Invalidate ;
end ;

function TMedaObject.GetLink : TMedaObject ;
begin
  Result := nil ;
end ;

procedure TMedaObject.Update ;
begin
  inherited ;
  if assigned( fParent ) then
    fParent.Update ;
end ;

function TMedaObject.FindNodeByGUID( aID : TGUID ) : TMedaObject ;
begin
  Result := nil ;
  if IsEqualGUID( ID, aID ) then
    Result := Self ;
end ;

function TMedaObject.Clone : TMedaObject ;
begin
  Result := TMedaObject.Create ;
end ;

function TMedaObject.GetCount : integer ;
begin
  Result := 0 ;
end ;

procedure TMedaObject.AddPolygon( aPoints : array of TGPPointF ) ;
begin
  if assigned( fPath ) then begin
    fPath.StartFigure ;
    fPath.AddPolygon( PGPPointF( @aPoints[ 0 ] ), length( aPoints ) ) ;
    fPath.CloseFigure ;
    fPath.SetMarker ;
  end ;
end ;

procedure TMedaObject.AddLine( x1, y1, x2, y2 : single ) ;
begin
  if assigned( fPath ) then begin
    fPath.StartFigure ;
    fPath.AddLine( x1, y1, x2, y2 ) ;
    fPath.SetMarker ;
  end ;
end ;

procedure TMedaObject.AddRectangle( x1, y1, x2, y2 : single ) ;
var
  p1, p2            : TGPPointF ;
  s                 : TGPSizeF ;
begin
  if assigned( fPath ) then begin
    p1 := MakePoint( minF( x1, x2 ), minF( y1, y2 ) ) ;
    p2 := MakePoint( maxF( x1, x2 ), maxF( y1, y2 ) ) ;
    s := MakeSize( p2.x - p1.x, p2.y - p1.y ) ;
    fPath.StartFigure ;
    fPath.AddRectangle( MakeRect( p1, s ) ) ;
    fPath.SetMarker ;
  end ;
end ;

procedure TMedaObject.AddRoundRect( x1, y1, x2, y2, r : single ) ;
begin
  if assigned( fPath ) then begin
    fPath.StartFigure ;
    fPath.AddLine( x1 + r, y1, x2 - r, y1 ) ;
    fPath.AddArc( x2 - 2 * r, y1, 2 * r, 2 * r, 270, 90 ) ;
    fPath.AddLine( x2, y1 + r, x2, y2 - r ) ;
    fPath.AddArc( x2 - 2 * r, y2 - 2 * r, 2 * r, 2 * r, 0, 90 ) ;
    fPath.AddLine( x2 - r, y2, x1 + r, y2 ) ;
    fPath.AddArc( x1, y2 - 2 * r, 2 * r, 2 * r, 90, 90 ) ;
    fPath.AddLine( x1, y2 - r, x1, y1 + r ) ;
    fPath.AddArc( x1, y1, 2 * r, 2 * r, 180, 90 ) ;
    fPath.SetMarker ;
  end ;
end ;

procedure TMedaObject.AddSemiRoundRect( x1, y1, x2, y2, r : single ) ;
begin
  if assigned( fPath ) then begin
    fPath.StartFigure ;
    fPath.AddLine( x1, y1, x2 - r, y1 ) ;
    fPath.AddArc( x2 - 2 * r, y1, 2 * r, 2 * r, 270, 90 ) ;
    fPath.AddLine( x2, y1 + r, x2, y2 - r ) ;
    fPath.AddArc( x2 - 2 * r, y2 - 2 * r, 2 * r, 2 * r, 0, 90 ) ;
    fPath.AddLine( x2 - r, y2, x1, y2 ) ;
    fPath.CloseFigure ;
    fPath.SetMarker ;
  end ;
end ;

procedure TMedaObject.AddSemiRoundRect2( x1, y1, x2, y2, r : single ) ;
begin
  if assigned( fPath ) then begin
    fPath.StartFigure ;
    fPath.AddArc( x1, y1, 2 * r, 2 * r, 180, 90 ) ;
    fPath.AddLine( x1 + r, y1, x2, y1 ) ;
    fPath.AddLine( x2, y1, x2, y2 ) ;
    fPath.AddLine( x2, y2, x1 + r, y2 ) ;
    fPath.AddArc( x1, y2 - 2 * r, 2 * r, 2 * r, 90, 90 ) ;
    fPath.CloseFigure ;
    fPath.SetMarker ;
  end ;
end ;

procedure TMedaObject.AddEllipse( x1, y1, x2, y2 : single ) ;
var
  p1, p2            : TGPPointF ;
  s                 : TGPSizeF ;
begin
  if assigned( fPath ) then begin
    p1 := MakePoint( minF( x1, x2 ), minF( y1, y2 ) ) ;
    p2 := MakePoint( maxF( x1, x2 ), maxF( y1, y2 ) ) ;
    s := MakeSize( p2.x - p1.x, p2.y - p1.y ) ;
    fPath.StartFigure ;
    fPath.AddEllipse( MakeRect( p1, s ) ) ;
    fPath.SetMarker ;
  end ;
end ;

procedure TMedaObject.AddArc( x1, y1, x2, y2 : single ; a1, a2 : single ) ;
var
  p1, p2            : TGPPointF ;
  s                 : TGPSizeF ;
begin
  if assigned( fPath ) then begin
    p1 := MakePoint( minF( x1, x2 ), minF( y1, y2 ) ) ;
    p2 := MakePoint( maxF( x1, x2 ), maxF( y1, y2 ) ) ;
    s := MakeSize( p2.x - p1.x, p2.y - p1.y ) ;
    fPath.StartFigure ;
    fPath.AddArc( MakeRect( p1, s ), a1, abs( a2 - a1 ) ) ;
    fPath.SetMarker ;
  end ;
end ;

function TMedaObject.GetTransform( index : integer ) : TMedaTransform ;
begin
  Result.Position := MakePoint( 0.0, 0.0 ) ;
  Result.Rotation := 45 * integer( drEast ) ;
  Result.Mirror := False ;
  if index < 4 then
    Result := fTransforms[ index ] ;
end ;

procedure TMedaObject.SetTransform( index : integer ; const Value : TMedaTransform ) ;
begin
  if index < 4 then begin
    Invalidate ;
    fTransforms[ index ] := Value ;
    Invalidate ;
  end ;
end ;

procedure TMedaObject.SetFlags( const Value : TMedaFlagsSet ) ;
begin
  fFlags := Value ;
  Invalidate ;
end ;

function TMedaObject.GetOutline : TGPRectF ;
begin
  fPath.GetBounds( Result ) ;
end ;

function TMedaObject.GetBounds : TGPRectF ;
var
  r                 : TGPRectF ;
  // TMedaDir = ( drEast, drNE, drNorth, drNW, drWest, drSW, drSouth, drSE ) ;
begin
  Result := GetOutline ;
  r := Result ;
  case TMedaDir( Rotation div 45 ) of
    drEast : ;
    drNE : ;
    drNorth : begin
        Result.X := r.Y ;
        Result.Y := -r.X - r.Width ;
        Result.Width := r.Height ;
        Result.Height := r.Width ;
      end ;
    drNW : ;
    drWest : begin
        Result.X := -r.X - r.Width ;
        Result.Y := -r.Y - r.Height ;
      end ;
    drSW : ;
    drSouth : begin
        Result.X := -r.Y - r.Height ;
        Result.Y := r.X ;
        Result.Width := r.Height ;
        Result.Height := r.Width ;
      end ;
    drSE : ;
  end ;
  if Mirror then
    Result.X := -Result.X - Result.Width ;
  Result.X := Result.X + Position.X ;
  Result.Y := Result.Y + Position.Y ;
end ;

function TMedaObject.GetConnector( aPos : TGPPointF ) : TGPPointF ;
begin
  Result := Position ;
end ;

function TMedaObject.PlacedAt( aPlace : TMedaViewable ) : boolean ;
begin
  Result := assigned( fView ) and ( TMedaView( fView ).Viewer = aPlace ) ;
end ;

function TMedaObject.GetFlagsAsString : string ;
const
  Flags             : array[ boolean ] of string = ( '0', '1' ) ;
begin
  Result := Flags[ vfDesignator in fFlags ] ;
  Result := Flags[ vfName in fFlags ] + Result ;
  Result := Flags[ vfBody in fFlags ] + Result ;
  Result := Flags[ vfPower in fFlags ] + Result ;
end ;

procedure TMedaObject.SetFlagsAsString( const Value : string ) ;
begin
  fFlags := [ ] ;
  if length( Value ) = 4 then begin
    if Value[ 1 ] = '1' then
      Include( fFlags, vfPower ) ;
    if Value[ 2 ] = '1' then
      Include( fFlags, vfBody ) ;
    if Value[ 3 ] = '1' then
      Include( fFlags, vfName ) ;
    if Value[ 4 ] = '1' then
      Include( fFlags, vfDesignator ) ;
  end ;
end ;

procedure TMedaObject.SetPath( const Value : TGPGraphicsPath ) ;
begin
  if assigned( fPath ) then
    fPath.Free ;
  fPath := Value ;
end ;

procedure TMedaObject.Rotate( aAngle : integer ) ;
begin
  Invalidate ;
  fTransforms[ 0 ].Rotation := ( fTransforms[ 0 ].Rotation + 45 ) mod 360 ;
  Invalidate ;
  Update ;
end ;

procedure TMedaObject.Mirrorize ;
begin
  Invalidate ;
  fTransforms[ 0 ].Mirror := not fTransforms[ 0 ].Mirror ;
  Invalidate ;
  Update ;
end ;

procedure TMedaObject.SetView( const Value : TMedaViewable ) ;
begin
  fView := Value ;
end ;

function TMedaObject.GetLayer : TMedaLayerType ;
begin
  Result := lcNone ;
  if assigned( fView ) then
    Result := ( fView as TMedaView ).LayerType ;
end ;

function TMedaObject.GetLayerType : TMedaLayerType ;
begin
  Result := fLayerType ;
end ;

function TMedaObject.GetPage : TMedaPageNumber ;
begin
  Result := -1 ;
  if assigned( fView ) then
    Result := ( fView as TMedaView ).PageNumber ;
end ;

function TMedaObject.GetPlaceRef : TGUID ;
begin
  Result := fPlaceRef ;
end ;

function TMedaObject.GetPlaceRefAsString : string ;
begin
  Result := GUIDToString( fPlaceRef ) ;
end ;

procedure TMedaObject.SetLayerType( const Value : TMedaLayerType ) ;
begin
  fLayerType := Value ;
end ;

{ TMedaVisible }

function TMedaVisible.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMedaVisibleContainer }

function TMedaVisibleContainer.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

{ TMedaRatsNest }

function TMedaRatsNest.Accept( Visitor : TObject ) : TObject ;
begin
  Result := TMedaVisitor( Visitor ).VisitNode( Self ) ;
end ;

procedure TMedaRatsNest.Add( var aObject : TMedaObject ) ;
begin
  if assigned( aObject ) then begin
    fObjects.Add( aObject ) ;
    Update ;
  end ;
end ;

constructor TMedaRatsNest.Create ;
begin
  inherited ;
  fObjects.OwnsObjects := False ;
end ;

procedure TMedaRatsNest.Delete( index : integer ) ;
begin
  if index < Count then begin
    if assigned( Objects[ index ] ) then begin
      Objects[ index ].Parent := nil ;
      Objects[ index ].Vaporize ;
    end ;
    Update ;
  end ;
end ;

function TMedaRatsNest.Extract( aObject : TMedaObject ) : TMedaObject ;
begin
  Result := nil ;
  if assigned( aObject ) then begin
    Result := fObjects.Extract( aObject ) as TMedaObject ;
    Update ;
  end ;
end ;

// should be implemented similiar to a view

procedure TMedaRatsNest.PaintAtSchematic( aGraphics : TMedaGraphics ; aPlace : TMedaViewable ) ;
var
  i, j              : integer ;
  iPort             : TMedaPort ;
  iPoints           : array of TGPPointF ;
begin
  fPlace := aPlace ;
  Sort ;
  iPoints := nil ;
  try
    j := 0 ;
    for i := 0 to fObjects.Count - 1 do begin
      iPort := TMedaPort( fObjects[ i ] ) ;
      if assigned( iPort ) and
        assigned( iPort.Pin ) and
        iPort.Pin.PlacedAt( aPlace ) then begin
        SetLength( iPoints, j + 1 ) ;
        iPoints[ j ] := iPort.Pin.GetConnector( MakePoint( 0.0, 0.0 ) ) ;
        inc( j ) ;
      end ;
    end ;
    if j > 1 then
      aGraphics.MemGraphics.DrawLines( gRatsPenSch, PGPPointF( @iPoints[ 0 ] ), j ) ;
  finally
    iPoints := nil ;
    fPlace := nil ;
  end ;
end ;

procedure TMedaRatsNest.Remove( aObject : TMedaObject ) ;
begin
  if assigned( aObject ) then begin
    fObjects.Remove( aObject ) ;
    Update ;
  end ;
end ;

procedure TMedaRatsNest.PaintAtPCB( aGraphics : TMedaGraphics ) ;
var
  i, j              : integer ;
  iPort             : TMedaPort ;
  iPoints           : array of TGPPointF ;
begin
  Sort ;
  iPoints := nil ;
  try
    j := 0 ;
    for i := 0 to fObjects.Count - 1 do begin
      iPort := TMedaPort( fObjects[ i ] ) ;
      if assigned( iPort ) and assigned( iPort.Stack ) then begin
        SetLength( iPoints, j + 1 ) ;
        iPoints[ j ] := iPort.Stack.Pad[ 0 ].GetConnector( iPort.Stack.Pad[ 0 ].Position ) ;
        inc( j ) ;
      end ;
    end ;
    if j > 1 then
      aGraphics.MemGraphics.DrawLines( gRatsPenPCB, PGPPointF( @iPoints[ 0 ] ), j ) ;
  finally
    iPoints := nil ;
  end ;
end ;

function RatsNetsCompareX( Item1, Item2 : Pointer ) : Integer ;
begin
  Result := Round( TMedaPin( TObject( Item1 ) ).Position.X - TMedaPin( TObject( Item2 ) ).Position.X ) ;
  if Result = 0 then
    Result := Round( TMedaPin( TObject( Item1 ) ).Position.Y - TMedaPin( TObject( Item2 ) ).Position.Y ) ;
end ;

function RatsNetsCompareY( Item1, Item2 : Pointer ) : Integer ;
begin
  Result := Round( TMedaPin( TObject( Item1 ) ).Position.Y - TMedaPin( TObject( Item2 ) ).Position.Y ) ;
  if Result = 0 then
    Result := Round( TMedaPin( TObject( Item1 ) ).Position.X - TMedaPin( TObject( Item2 ) ).Position.X ) ;
end ;

procedure TMedaRatsNest.SetParent( const Value : TMedaContainer ) ;
begin
end ;

procedure TMedaRatsNest.Sort ;
var
  i, j              : integer ;
  min               : single ;
  delta, index      : int64 ;
  iObj              : TObject ;
  iP                : TGPPointF ;
begin
  if not assigned( fPlace ) then
    Exit ;
  if fObjects.Count < 2 then
    Exit ;

  // smallest left/top most in front
  min := MAXINT ;
  index := 0 ;
  iP := MakePoint( 0.0, 0.0 ) ;
  for i := 0 to fObjects.Count - 1 do
    if ( fObjects[ i ] is TMedaPin ) and TMedaPin( fObjects[ i ] ).PlacedAt( fPlace ) then begin
      delta := Round( Distance( TMedaPin( fObjects[ i ] ).Position, iP ) ) ;
      if min > delta then begin
        min := TMedaPin( fObjects[ i ] ).Position.X ;
        index := i ;
      end ;
    end ;
  if index > 0 then begin
    iObj := fObjects[ 0 ] ;
    fObjects[ 0 ] := fObjects[ index ] ;
    fObjects[ index ] := iObj ;
  end ;

  if fObjects.Count = 2 then
    Exit ;

  // minimum distance to next
  for i := 0 to fObjects.Count - 1 do
    if ( fObjects[ i ] is TMedaPin ) and TMedaPin( fObjects[ i ] ).PlacedAt( fPlace ) then begin
      min := MAXINT ;
      index := i ;
      for j := i + 1 to fObjects.Count - 1 do
        if ( fObjects[ j ] is TMedaPin ) and TMedaPin( fObjects[ j ] ).PlacedAt( fPlace ) then begin
          delta := Round( Distance( TMedaPin( fObjects[ i ] ).Position, TMedaPin( fObjects[ j ] ).Position ) ) ;
          if min > delta then begin
            min := delta ;
            index := j ;
          end ;
        end ;
      if index > i + 1 then begin
        iObj := fObjects[ i + 1 ] ;
        fObjects[ i + 1 ] := fObjects[ index ] ;
        fObjects[ index ] := iObj ;
      end ;
    end ;
end ;

procedure TMedaRatsNest.Vaporize ;
var
  i                 : integer ;
begin
  for i := Count - 1 downto 0 do
    if assigned( Objects[ i ] ) then
      TMedaPort( Objects[ i ] ).Net := nil ;
  fObjects.Clear ;

  if assigned( fParent ) then
    fParent.Remove( Self ) ;
  Update ;
end ;

{ TMedaTriStateContainer }

function TMedaTriStateContainer.CheckType : TCheckType ;
begin
  Result := ctNone ;
  if GetChildCount > 0 then
    Result := ctTristateCheckbox ;
end ;

{ TMedaSubContainer }

procedure TMedaSubContainer.Add( var aObject : TMedaObject ) ;
begin
  if fObjects.Count = 0 then
    fParent.Add( TMedaObject( Self ) ) ;

  Assert( assigned( aObject ) ) ;
  // the grandparent is the parent
  aObject.Parent := fParent ;
  aObject.Module := fModule ;
  inherited ;
end ;

procedure TMedaSubContainer.Delete( index : integer ) ;
begin
  inherited ;
  if fObjects.Count = 0 then
    fParent.Remove( TMedaObject( Self ) ) ;
end ;

function TMedaSubContainer.Extract( aObject : TMedaObject ) : TMedaObject ;
begin
  Result := inherited Extract( aObject ) ;
  if fObjects.Count = 0 then
    fParent.Remove( TMedaObject( Self ) ) ;
end ;

procedure TMedaSubContainer.Remove( aObject : TMedaObject ) ;
begin
  inherited ;
  if fObjects.Count = 0 then
    fParent.Remove( TMedaObject( Self ) ) ;
end ;

procedure TMedaSubContainer.RemoveAll ;
begin
  inherited ;
  if fObjects.Count = 0 then
    fParent.Remove( TMedaObject( Self ) ) ;
end ;

initialization
  gDesignators := TStringlist.Create ;

  gRatsPenSch := TGPPen.Create( aclRatsPenSch, 2 ) ;
  gRatsPenSch.SetStartCap( LineCapRoundAnchor ) ;
  gRatsPenSch.SetEndCap( LineCapRoundAnchor ) ;
  gRatsPenSch.SetLineJoin( LineJoinRound ) ;
  gRatsPenPCB := TGPPen.Create( aclRatsPenPCB, 8 ) ;
  gRatsPenPCB.SetStartCap( LineCapRoundAnchor ) ;
  gRatsPenPCB.SetEndCap( LineCapRoundAnchor ) ;
  gRatsPenPCB.SetLineJoin( LineJoinRound ) ;

finalization
  gRatsPenSch.Free ;
  gRatsPenPCB.Free ;

  gDesignators.Free ;

end.

